Prüfungsleistung Data Science & Machine Learning: Salary by job title and country

Author

Mathis, Julia und Jonas

Published

November 13, 2023

1. Vorbereitung

Im folgenden Teil dieser Arbeit werden die Vorbereitungen getroffen, die notwendig sind um die Durchführung des Projekts zu ermöglichen.

https://www.kaggle.com/datasets/amirmahdiabbootalebi/salary-by-job-title-and-country

Zusätzliche Quellen für die Methodik:

https://www.datanovia.com/en/blog/top-r-color-palettes-to-know-for-great-data-visualization/

https://ggplot2.tidyverse.org/reference/

ggplot2 - Elegante R Plots (statistikprofis.com)

https://statologie.de/daten-standardisieren-r/

https://statologie.de/vorhergesagte-werte-plotten-r/

https://cran.r-project.org/web/packages/yardstick/yardstick.pdf

Dieses Datenset bietet eine umfassende Sammlung von Gehaltsinformationen aus verschiedenen Branchen und Regionen weltweit. Es enthält Details zu Berufsbezeichnungen, Gehältern, Berufssektoren, geografischen Standorten und mehr, die von seriösen Beschäftigungswebsites und Umfragen stammen. Analysieren Sie diese Daten, um Einblicke in Trends auf dem Arbeitsmarkt zu gewinnen, Vergütungen in verschiedenen Berufen zu vergleichen und informierte Entscheidungen über Ihre Karriere oder Einstellungsstrategien zu treffen. Das Datenset ist zur einfachen Analyse bereinigt und vorverarbeitet und steht unter einer offenen Lizenz für Forschungs- und Datenanalysezwecke zur Verfügung.

1.1 Importieren der benötigten Packages

Code
library(tidyverse)
library(tidymodels)
library(corrplot)
library(explore) 
library(ggplot2)
library(corrplot)
library(dplyr)
library(viridis)
library(rpart.plot)
library(yardstick)

Häufig kommt:
WARNING: Rtools is required to build R packages but is not currently installed. Please download and install the appropriate version of Rtools before proceeding: https://cran.rstudio.com/bin/windows/Rtools/ Warning in install.packages : Paket ‘dplyr’ wird gerade benutzt und deshab nicht installiert

Installiere RTools nach Link: https://cran.rstudio.com/bin/windows/Rtools/rtools43/rtools.html

1.2 Einlesen der zu Analysierenden Daten

Der Datensatz, der in diesem Projekt analysiert wird, stammt von der website “Kaggle” und beschreibt das Gehalt nach Job und Land in dem gearbeitet wird.

Code
salary <- read_csv("Salary.csv")
Rows: 6684 Columns: 9
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (4): Gender, Job Title, Country, Race
dbl (5): Age, Education Level, Years of Experience, Salary, Senior

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

2. Erster Überblick der Daten

Um einen ersten Überblick zu erhalten, werden die ersten 10 Zeilen der Tabelle ausgelesen:

Code
head(salary, 10)
# A tibble: 10 × 9
     Age Gender `Education Level` `Job Title`       `Years of Experience` Salary
   <dbl> <chr>              <dbl> <chr>                             <dbl>  <dbl>
 1    32 Male                   1 Software Engineer                     5  90000
 2    28 Female                 2 Data Analyst                          3  65000
 3    45 Male                   3 Manager                              15 150000
 4    36 Female                 1 Sales Associate                       7  60000
 5    52 Male                   2 Director                             20 200000
 6    29 Male                   1 Marketing Analyst                     2  55000
 7    42 Female                 2 Product Manager                      12 120000
 8    31 Male                   1 Sales Manager                         4  80000
 9    26 Female                 1 Marketing Coordi…                     1  45000
10    38 Male                   3 Scientist                            10 110000
# ℹ 3 more variables: Country <chr>, Race <chr>, Senior <dbl>

Mithilfe der “describe_tbl”- Funktion können die generellen Informationen über den Datensatz ermittelt werden.

Code
describe_tbl(salary)
6 684 (6.7k) observations with 9 variables
0 observations containing missings (NA)
0 variables containing missings (NA)
0 variables with no variance

Wie oben zu erkennen, enthält der Datensatz 6684 Instanzen, wovon keine einen Wert ohne Angabe (NA’s) besitzt.

Nun wird ein kurzer Blick auf die Art der Merkmale geholfen. Gibt es kategorische oder nummerische Merkmale innerhalb des Datensatzes?

Code
describe(salary)
# A tibble: 9 × 8
  variable            type     na na_pct unique   min      mean    max
  <chr>               <chr> <int>  <dbl>  <int> <dbl>     <dbl>  <dbl>
1 Age                 dbl       0      0     41    21     33.6      62
2 Gender              chr       0      0      2    NA     NA        NA
3 Education Level     dbl       0      0      4     0      1.62      3
4 Job Title           chr       0      0    129    NA     NA        NA
5 Years of Experience dbl       0      0     37     0      8.08     34
6 Salary              dbl       0      0    437   350 115307.   250000
7 Country             chr       0      0      5    NA     NA        NA
8 Race                chr       0      0     10    NA     NA        NA
9 Senior              dbl       0      0      2     0      0.14      1
Wie bereits oben in der Tabelle zu erkennen gibt es Innerhalb des Datensatzes nur zwei verschiedene Datentypen. Die Felder *Age, Education Level, Years of Experience, Salary, Senior* sind nummerische Merkmale. Die Felder Gender, Job Title, Country, Race sind kategorische Merkmale.
Spalte Typ Bedeutung
Age Numerisch Alter
Gender Kategorisch Geschlecht
Education Level Numerisch Bildungsgrad
Job Title Kategorisch Jobtitel
Years of Experience Numerisch Arbeitserfahrung in Jahren
Salary Numerisch Gehalt
Country Kategorisch Land
Race Kategorisch Ethnizität
Senior Numerisch Senior position ja(1)/nein(0)

2.1 Bedeutung von Spalten und Datentypen

Im folgenden Abschnitt werden verschiedene Funktionen dafür verwendet, um die Datentypen und Bedeutung der Spalten zu verstehen.

Code
salary <- salary |>
    rename(
      Job.Title = `Job Title`,
      Years.Of.Experience = `Years of Experience`,
      Education.Level = `Education Level`
    )

Hier werden die Spaltennamen der Spalten verändert, welche ein Leerzeichen im Namen haben. Es handelt sich hierbei um die Spalten “Job Title”, “Years of Experience” und “Education level”. Das Leerzeichen wird einfach durch einen Punkt ersetzt. Da noch häufig im Laufe des Projektes auf die Spaltennamen zugegriffen werdne muss, wird Uns das in der Zukunft noch Zeit sparen.

Nun werfen verschaffen Wir uns einen Überblick über die prozentuale Verteilung der Jobtitel. Aus der Grafik geht hervor, dass der Beruf des “Data Scientist” der meist ausgeführte Beruf ist. Außerdem gibt es innerhalb des Datensatzes auch viele “Data Analsysten” , sowie auch “Backend Devolper”.

Code
explore (salary, Job.Title)

Altersverteilung:

Code
ggplot(salary, aes(x = Age)) +
  geom_histogram(binwidth = 5, fill = "skyblue", color = "black", alpha = 0.8) +
  labs(title = "Age Distribution",
       x = "Age",
       y = "Frequency")

Verteilung des Bildungsniveaus:

Zunächst wird hier eine Farbpalette mit verschiedenen Farben definiert. Danach wird ein Blakendiagramm mit den unterschiedlichen Farben für jede Stange, basierend auf dem Bildungsniveau, erstellt.

Code
my_colors <- c("skyblue", "lightgreen", "salmon", "gold") 
ggplot(salary, aes(x = factor(`Education.Level`))) +
  geom_bar(fill = my_colors, color = "black") +
  labs(title = "Verteilung des Bildungsniveaus",
       x = "Bildungsniveau",
       y = "Anzahl") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Verteilung der Arbeitserfahrung in Jahren

Ab hier wurde Teilweise das Paket “Viridis” für die farbliche Darstellung verwendet um eine Alternative zur Manuellen Deklaration der Farben aufzuzeigen.

Code
ggplot(salary, aes(x = `Years.Of.Experience`)) +
  geom_histogram(binwidth = 5, fill = viridis(8), color = "black") +
  labs(title = "Verteilung der Berufserfahrung",
       x = "Jahre an Erfahrung",
       y = "Häufigkeit") +
  theme_minimal()

Verteilung der Geschlechter:

Code
ggplot(salary, aes(x=Gender)) +
  geom_bar(fill=viridis(2)) +
  ggtitle("Gender Distribution") +
  xlab("Gender") +
  ylab("Count") +
  theme(plot.title = element_text(hjust = 0.5))

Verteilung der Länder:

(Alternative Nutzung des Farbschemas):

Code
ggplot(salary, aes(x = Country, fill = Country)) +
  geom_bar() +
  scale_fill_viridis(discrete = TRUE) +
  ggtitle("Country Distribution") +
  xlab("Country") +
  ylab("Count") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Verteilung der Ethnizitäten:

Code
ggplot(salary, aes(x = Race, fill = Race)) +
  geom_bar() +
  scale_fill_viridis(discrete = TRUE) +
  ggtitle("Race Distribution") +
  xlab("Race") +
  ylab("Count") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Verteilung der 10 Häufigsten Job Titel:

Code
# Die Top 10 Jobtitel auswählen
top_job_titles <- names(sort(table(salary$Job.Title), decreasing = TRUE)[1:10])

# Zufällige Farben für jeden Jobtitel generieren
job_colors <- rainbow(length(top_job_titles))

# Daten filtern und ggplot erstellen
ggplot(salary[salary$Job.Title %in% top_job_titles, ], aes(x = factor(Job.Title, levels = top_job_titles), fill = factor(Job.Title))) +
  geom_bar(fill=viridis(10)) +
  scale_fill_manual(values = job_colors) +
  labs(title = "Top 10 Job Titles Distribution",
       x = "Job Title",
       y = "Count") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

2.2 Grundlegende Statistische Merkmale des Datensatzes

Zunächst wird mithilfe der Funktion “summary( )” ein allgemeiner Überblick über die wichtigsten charackteristeischen Merkmale der einzelnen Splaten gegeben.

Code
summary(salary)
      Age           Gender          Education.Level  Job.Title        
 Min.   :21.00   Length:6684        Min.   :0.000   Length:6684       
 1st Qu.:28.00   Class :character   1st Qu.:1.000   Class :character  
 Median :32.00   Mode  :character   Median :1.000   Mode  :character  
 Mean   :33.61                      Mean   :1.622                     
 3rd Qu.:38.00                      3rd Qu.:2.000                     
 Max.   :62.00                      Max.   :3.000                     
 Years.Of.Experience     Salary         Country              Race          
 Min.   : 0.000      Min.   :   350   Length:6684        Length:6684       
 1st Qu.: 3.000      1st Qu.: 70000   Class :character   Class :character  
 Median : 7.000      Median :115000   Mode  :character   Mode  :character  
 Mean   : 8.078      Mean   :115307                                        
 3rd Qu.:12.000      3rd Qu.:160000                                        
 Max.   :34.000      Max.   :250000                                        
     Senior      
 Min.   :0.0000  
 1st Qu.:0.0000  
 Median :0.0000  
 Mean   :0.1435  
 3rd Qu.:0.0000  
 Max.   :1.0000  

Hier alles genauer beschreiben

Erkennbar hier ist es, dass es innerhalb des Datensatzes ein durchschnittliches Alter von 32 Jahren vorliegt. Das Alter streckt sich von 21 Jahren bis zu 62 Jahren. Außerdem gibt es beim “Education-Level” Werte zwischen 1, 2 und 3, wobei der Durchschnitt jedoch bei 1 liegt. Außerdem gibt es bei der Berufserfahrung ( Years of Experience) Werte zwischen 0 bis zu 34 Jahren. Der Median hier beträgt 7.

3. Umstrukturierung des Datensatzes zwecks Visualisierung

Im folgenden wird der Datensatz temporär umstrukturiert um den Datensatz besser analysieren und visualieren zu können.

Ein neuer Wert Namens “Value” wird erschaffen.

Code
Salary_long <- select(salary, -Job.Title, -Gender, -Race, -Country, -Senior)
Salary_long <- pivot_longer(Salary_long, colnames(Salary_long))
Salary <- as.data.frame(Salary_long) 
head(Salary_long)
# A tibble: 6 × 2
  name                value
  <chr>               <dbl>
1 Age                    32
2 Education.Level         1
3 Years.Of.Experience     5
4 Salary              90000
5 Age                    28
6 Education.Level         2

Insgesamt werden in diesem Codechunk die Spalten die nicht nummerische Merkmale sind entfernt und der verbleibende Datensatz wird von einem breiten in ein längeres Format umgewandelt.

Hier kann man folgende Dinge erkennen:

  • Age, Years of Experience und Education Level sind Linksschief und haben ggf. Bedarf einer Transformation für ML-Modelle

  • Age und Years of Experience haben Extrempunkte im oberen Wertebereich, während Salary einer gleichmäßigen Verteilung folgt

Aufgrund der guten Strukturierung der Daten ,eignen sie sich dem ersten Anschein nach gut für eine Ausführliche Explorative Analyse.

3.1 Kategorisierung von Gehalt

Zunächst werden die Daten aus dem Ausgangsdatensatz in einen finalen Datensatz “salary_final” geschrieben.

Code
salary_final <- salary

Durch den Befehl “hist()” wird ein Histogramm erstellt . Es ermöglicht eine visuelle Darstellung der Häufigkeitsverteilung dieses Gehaltsdaten, indem es zeigt, wie oft bestimmte Gehaltsbereiche vorkommen.

Verteilung des Gehalts:

Code
ggplot(salary, aes(x = Salary)) +
  geom_histogram(binwidth = 10000, fill = viridis(26), color = "black") +
  labs(title = "Gehaltsverteilung",
       x = "Gehalt",
       y = "Häufigkeit") +
  scale_y_continuous(labels = scales::comma) +
  scale_x_continuous(labels = scales::comma) +
  theme_minimal()

Im folgenden wird eine neue Spalte “SalaryKat” erstellt die kategorische Werte basierend auf den Gehältern enthält. Anschließend wird ein Balkendiagramm für die 5 Kategorien des Gehalts erstellt.

Code
salary_final$SalaryKat <- cut(salary_final$Salary, 
                  breaks = c(-Inf, 50000, 100000, 150000, 200000, 250000, Inf),                      labels = c("50000", "100000", "150000", "200000","250000", "300000"))
Code
ggplot(salary_final, aes(x = SalaryKat, fill = SalaryKat)) +
  geom_bar() +
  scale_fill_viridis(discrete = TRUE) +
  ggtitle("Verteilung der Gehaltskategorien") +
  xlab("Gehaltskategorie") +
  ylab("Anzahl") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Die Kategorie mit einem Gehalt von 100.000 ist am häufigsten verteten.

3.2 Korrelationen

Im Folgenden werden die Korrelationen zwischen den verschiedenen Spalten errechnet.

Die Berechnung von Korrelationen ermöglicht es, die Stärke und Richtung des Zusammenhangs zwischen zwei Variablen zu quantifizieren. Dies hilft bei der Modellvalisierung, um potenzielle Probleme, wie zum Beispiel die Multikollinearität zu erkennen.

Nun werden verschiedene Korrelationen errechnet:

Code
# Korrelation zwischen Salary und Years.Of.Experience berechnen
correlation_salary_experience <- cor(salary_final$Salary, salary_final$Years.Of.Experience)

# Ausgabe des Ergebnisses
cat("Die Korrelation zwischen Salary und Years.Of.Experience ist:", correlation_salary_experience, "\n")
Die Korrelation zwischen Salary und Years.Of.Experience ist: 0.8109416 

“Hier würde Ich keinen Text vorschreiben, Ausgabe aussagekräftig genug”

Code
# Korrelation zwischen Salary und Age berechnen
correlation_salary_age <- cor(salary_final$Salary, salary_final$Age, use = "complete.obs")

# Ausgabe des Ergebnisses
cat("Die Korrelation zwischen Salary und Age ist:", correlation_salary_age, "\n")
Die Korrelation zwischen Salary und Age ist: 0.7283429 

“Hier würde Ich keinen Text vorschreiben, Ausgabe aussagekräftig genug”

Code
# Korrelation zwischen Years.Of.Experience und Age berechnen
correlation_experience_age <- cor(salary_final$Years.Of.Experience, salary_final$Age, use = "complete.obs")

# Ausgabe des Ergebnisses
cat("Die Korrelation zwischen Years.Of.Experience und Age ist:", correlation_experience_age, "\n")
Die Korrelation zwischen Years.Of.Experience und Age ist: 0.9376094 

“Hier würde Ich keinen Text vorschreiben, Ausgabe aussagekräftig genug”

Code
# Korrelation zwischen Seniority und Years.Of.Experience berechnen
correlation_seniority_experience <- cor(salary_final$Senior, salary_final$Years.Of.Experience, use = "complete.obs")

# Ausgabe des Ergebnisses
cat("Die Korrelation zwischen Seniority und Years.Of.Experience ist:", correlation_seniority_experience, "\n")
Die Korrelation zwischen Seniority und Years.Of.Experience ist: 0.3178772 

Die Ergebnisse der Korrelationen:

  • Von salary und years.of.experience ist es 0.81.

  • Von Salary und Age ist es 0.73

  • von Age und Years of Experience st es 0.93.

Nun stellt sich folgende Frage, wie kommt bei den Werten so ein starker Unterschied, im Vergleich zu Salary, zustande, obwohl sie doch eine so hohe Korrelation zueinander haben.

Lösungsansätze:

Verteilung der Daten: Es ist möglich, dass die Verteilung der Daten in den Variablen “Age” und “Years.Of.Experience” anders ist als in der Variable “Salary”. Wenn die Daten in “Age” und “Years.Of.Experience” breiter gestreut sind, kann dies zu einer geringeren Korrelation führen, selbst wenn eine starke lineare Beziehung besteht.

Nicht-lineare Beziehung: Die Korrelation misst nur lineare Beziehungen. Wenn die Beziehung zwischen “Age” und “Years.Of.Experience” nicht linear ist, könnte dies zu einem niedrigeren Korrelationswert führen.

Ausreißer: Das Vorhandensein von Ausreißern kann die Korrelation beeinflussen. Wenn es Ausreißer in einer der Variablen gibt, kann dies den Korrelationswert beeinträchtigen.

Stichprobengröße: Bei kleineren Stichproben können Korrelationswerte instabiler sein.

4. Tests für die Thesen

Im folgenden werden anhand der Daten ein paar Tests durchgeführt um Aussagen für die Thesen heruaszufiltern. Dies geschieht mithilfe einer Visualisierung der Beziehungen zwischen den verschiedenen Spalten, sowie mitihilfe von Korrelationen.

4.1 Korrelationen

Das Ergebnis dieses Codechunks ist eine Darstellung der Korrelationsmatrix:

Code
correlations <- cor(salary_final[, c("Age", "Education.Level", "Years.Of.Experience", "Salary")])

print(correlations)
                          Age Education.Level Years.Of.Experience    Salary
Age                 1.0000000       0.5963804           0.9376094 0.7283429
Education.Level     0.5963804       1.0000000           0.6131650 0.6454436
Years.Of.Experience 0.9376094       0.6131650           1.0000000 0.8109416
Salary              0.7283429       0.6454436           0.8109416 1.0000000

Erkennbar hier ist eine starke Korrelation zwischen dem Alter und den “Years of Experience”. Desweiteren liegt auch eine starke Korrelation zwischnem den Years of Experience und dem entgültigen Gehalt. Eine nicht so starke Korrelation liegt zwischen dem Alter und dem Education Level mit einem Wert von ungefähr 0,6.

Code
filtered_data_numeric <- select(salary, Salary, Age, Years.Of.Experience, Education.Level)
glimpse(filtered_data_numeric)
Rows: 6,684
Columns: 4
$ Salary              <dbl> 90000, 65000, 150000, 60000, 200000, 55000, 120000…
$ Age                 <dbl> 32, 28, 45, 36, 52, 29, 42, 31, 26, 38, 29, 48, 35…
$ Years.Of.Experience <dbl> 5, 3, 15, 7, 20, 2, 12, 4, 1, 10, 3, 18, 6, 14, 2,…
$ Education.Level     <dbl> 1, 2, 3, 1, 2, 1, 2, 1, 1, 3, 2, 1, 1, 2, 1, 1, 2,…
Code
cor(filtered_data_numeric)
                       Salary       Age Years.Of.Experience Education.Level
Salary              1.0000000 0.7283429           0.8109416       0.6454436
Age                 0.7283429 1.0000000           0.9376094       0.5963804
Years.Of.Experience 0.8109416 0.9376094           1.0000000       0.6131650
Education.Level     0.6454436 0.5963804           0.6131650       1.0000000

Nun wird der Korrelationsplot erstellt.

Code
corrplot(cor(filtered_data_numeric), method = "ellipse", col = viridis(200))

4.2 Streudiagramme

Code
ggplot(salary_final, aes(x = Years.Of.Experience, y = Salary)) +
  geom_point(color = viridis(2)[1], size = 3, shape = 16) +
  labs(title = "Streudiagramm von Berufserfahrung vs. Gehalt",
       x = "Berufserfahrung",
       y = "Gehalt")

In diesem Streudiagramm ist erkennbar, das es einen eindeutigen Trend nach oben gibt je mehr “Years of Experience” vorliegen. So ist auch zu sehen, dass die Topgehälter von 250.000€ zwischen 20 bis 30 Erfahrungsjahren liegen.

Code
ggplot(salary_final, aes(x = Education.Level, y = Salary)) +
  geom_point(color = viridis(2)[1], size = 3, shape = 16) +
  labs(title = "Scatter Plot of Education Level vs Salary",
       x = "Years of Experience",
       y = "Salary")

Die vorliegende Datenanalyse zeigt einen klaren Trend zu höheren Gehaltsklassen, der mit einem Anstieg des Bildungsniveaus einhergeht. Diese Tendenz wird durch eine höhere Dichte in den oberen Gehaltsgruppen für Personen mit dem dritten Bildungsgrad im Vergleich zum zweiten und ersten Bildungsgrad deutlich.

4.3 Balkendiagramme mit 2 Variablen

In diesem Abschnitt werden Balkendiagramme verwendet um den Datensatz auf Beziehungen zu analysieren.

4.3.1 Average Salary by Race

Code
ggplot(salary_final, aes(x = Race, y = Salary, fill = Race)) +
  stat_summary(fun = "mean", geom = "bar") +
  scale_fill_viridis(discrete = TRUE) +
  ggtitle("Durchschnittliches Gehalt nach Ethnizität") +
  xlab("Rasse") +
  ylab("Durchschnittliches Gehalt")

Die Grafik macht deutlich, dass die Gruppen “Black, Korean, Mixed und White” im Durchschnitt am meisten verdienen.

4.3.2 Average Salary by Country

Code
ggplot(salary_final, aes(x = Country, y = Salary, fill = Country)) +
  stat_summary(fun = "mean", geom = "bar", position = "dodge", color = "black") +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Durchschnittliches Gehalt nach Land",
       x = "Land",
       y = "Durchschnittliches Gehalt") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Es ist ersichtlich, dass in den Ländern “Canada und China” das durchschnittliche Gehalt am größten ist. Jedochg ist zu erwähnen, dass alle Länder nah bei einander liegen.

4.3.3 Average Salary by Country and Gender

In diesem Fall wird ein gestapeltes Balkendiagramm erstellt. Die Balken sind nach Geschlecht gruppiert und gestapelt. DIes ermöglicht einen Vergleich der durchschnittlichen Gehälter zwischen den Ländern und Geschlechtern

Code
ggplot(salary_final, aes(x = Country, y = Salary, fill = Gender)) +
  geom_bar(stat = "summary", fun = "mean", position = "stack", color = "black") +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Average Salary by Country and Gender",
       x = "Country",
       y = "Average Salary") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) 

Hier ist zu erkennen, das alle Länder ungefähr die gleiche Verteilung zwischen “Male” und “Female” haben.

4.3.4 Average Salary by Country and Education Level

Zur Visualisierung der durchnittlichen Bezahlung für Länder und Bildungsniveau wird ein gruppiertes Balkendiagramm verwendet. DIe Balken sind nach Bildungsniveau und nebeneinander gruppiert.

Desweiteren sind zur besseren Veranschaulichung die Beschriftungen auf der X-Achse um 45 Grad gedreht.

Code
ggplot(salary_final, aes(x = Country, y = Salary, fill = factor(Education.Level))) +
  geom_bar(stat = "summary", fun = "mean", position = "dodge", color = "black") +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Average Salary by Country and Education Level",
       x = "Country",
       y = "Average Salary") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))  

Es ist deutlich zu erkennen, dass die Gehälter in jedem Land deutlich ansteigen je höher das Bildungsniveau ist.

4.3.5 Average Salary by Country and Race

Auch hier wird zum Vergleich der durchschnittlichen Gehälter zwischen den Ländern und ethnischen Gruppen, ein gestapeltes Balkendiagramm erstellt. Die Balken sind nach ethnischer Gruppe gruppiert und gestapelt.

Code
ggplot(salary_final, aes(x = Country, y = Salary, fill = Race)) +
  geom_bar(stat = "summary", fun = "mean", position = "stack", color = "black") +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Average Salary by Country and Race",
       x = "Country",
       y = "Average Salary") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_y_continuous(labels = scales::comma)

!!!!! Salary passt nicht!!!!!!!

Hier ist deutlich sichtbar, dass nicht in jedem Land logischerweise jede ethnische Gruppe vertreten ist. So sind nur in 2 Ländern mehr als 3 verschiedene Gruppen in diesem Datensatz aufgeführt

4.3.6 Average Salary by Job Title

Code
ggplot(salary_final, aes(x = Job.Title, y = Salary)) +
  geom_bar(stat = "summary", fun = "mean", color = viridis(2)[1], color = viridis(2)[1]) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Average Salary by Job Title",
       x = "Job Title",
       y = "Average Salary") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))  
Warning: Duplicated aesthetics after name standardisation: colour

Hier wird festgestellt das in dem Datensatz zu viele Jobtitle vorkommen:

Code
job_title_count <- table(salary_final$Job.Title)
print(job_title_count)

               Account Executive                  Account Manager 
                               1                                4 
                      Accountant         Administrative Assistant 
                               6                                2 
         Advertising Coordinator               Back end Developer 
                               1                              242 
                Business Analyst   Business Development Associate 
                              20                                7 
    Business Development Manager    Business Intelligence Analyst 
                               5                                1 
     Business Operations Analyst                              CEO 
                               2                                1 
              Chief Data Officer         Chief Technology Officer 
                               1                                1 
                      Consultant        Content Marketing Manager 
                               1                               73 
                      Copywriter                Creative Director 
                               2                                1 
        Customer Service Manager             Customer Service Rep 
                               2                                1 
 Customer Service Representative         Customer Success Manager 
                               6                                1 
            Customer Success Rep      Customer Support Specialist 
                               1                                1 
                    Data Analyst                    Data Engineer 
                             391                                4 
                Data Entry Clerk                   Data Scientist 
                               1                              515 
                 Delivery Driver                         Designer 
                               5                                1 
                       Developer         Digital Content Producer 
                               1                                1 
       Digital Marketing Manager     Digital Marketing Specialist 
                              52                               15 
                        Director Director of Business Development 
                               1                                1 
        Director of Data Science          Director of Engineering 
                              57                                2 
             Director of Finance                   Director of HR 
                               2                               69 
       Director of Human Capital      Director of Human Resources 
                               1                                2 
           Director of Marketing           Director of Operations 
                              88                               11 
  Director of Product Management                Director of Sales 
                               1                                1 
 Director of Sales and Marketing                         Engineer 
                               1                                2 
               Event Coordinator                Financial Advisor 
                               2                                5 
               Financial Analyst                Financial Manager 
                              53                              139 
             Front end Developer              Front End Developer 
                             239                               31 
             Full Stack Engineer                 Graphic Designer 
                             304                               23 
               Help Desk Analyst                   HR Coordinator 
                               1                               29 
                   HR Generalist                       HR Manager 
                             104                                5 
                   HR Specialist      Human Resources Coordinator 
                               1                               50 
        Human Resources Director          Human Resources Manager 
                               1                              152 
      Human Resources Specialist                    IT Consultant 
                               1                                2 
                      IT Manager               IT Project Manager 
                               1                                1 
                      IT Support            IT Support Specialist 
                               1                                2 
          Juniour HR Coordinator            Juniour HR Generalist 
                               3                                3 
                         Manager                Marketing Analyst 
                               2                              144 
           Marketing Coordinator               Marketing Director 
                             167                               65 
               Marketing Manager             Marketing Specialist 
                             315                               10 
                Network Engineer                   Office Manager 
                               1                                1 
              Operations Analyst           Operations Coordinator 
                               8                                5 
             Operations Director               Operations Manager 
                               1                              122 
              Principal Engineer              Principal Scientist 
                               1                                1 
                Product Designer      Product Development Manager 
                              80                                1 
                 Product Manager        Product Marketing Manager 
                             323                               70 
             Project Coordinator                 Project Engineer 
                               5                              317 
                 Project Manager         Public Relations Manager 
                              34                                1 
       Quality Assurance Analyst                     Receptionist 
                               1                               57 
                       Recruiter                Research Director 
                               3                               75 
              Research Scientist                       Researcher 
                             119                                1 
                 Sales Associate                   Sales Director 
                             212                               62 
                 Sales Executive                    Sales Manager 
                              38                               58 
        Sales Operations Manager             Sales Representative 
                               1                               81 
                       Scientist                 Social Media Man 
                               3                                1 
            Social Media Manager          Social Media Specialist 
                              15                                2 
              Software Architect               Software Developer 
                               1                              186 
               Software Engineer        Software Engineer Manager 
                             809                              376 
                Software Manager         Software Project Manager 
                               1                                1 
             Strategy Consultant             Supply Chain Analyst 
                               1                                1 
            Supply Chain Manager              Technical Recruiter 
                               1                                1 
    Technical Support Specialist                 Technical Writer 
                               1                                1 
             Training Specialist                      UX Designer 
                               2                                5 
                   UX Researcher                    VP of Finance 
                               1                                1 
                VP of Operations                     Web Designer 
                               1                                1 
                   Web Developer 
                             129 

Hier nochmal das obere genauer grafisch herausgearbeitet:

Code
job_title_count <- table(salary_final$Job.Title)
job_title_df <- data.frame(Job_Title = names(job_title_count), Frequency = as.numeric(job_title_count))

ggplot(job_title_df, aes(x = Job_Title, y = Frequency)) +
  geom_bar(stat = "identity", fill = viridis(2)[1], color = "black") +
  labs(title = "Frequency of Unique Job Titles",
       x = "Job Titles",
       y = "Frequency") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) 

Jeder Job wurde Dargestellt. Es ist zu notieren das es nicht möglich ist die Vielzahl der unterschiedlichen Jobs darzustellen. Es ist nicht möglich die Vielzahl der unterschiedlichen Jobs dazustellen.

Code
library(dplyr)

job_title_count <- salary %>%
  count(`Job.Title`, sort = TRUE)
job_title_count
# A tibble: 129 × 2
   Job.Title                     n
   <chr>                     <int>
 1 Software Engineer           809
 2 Data Scientist              515
 3 Data Analyst                391
 4 Software Engineer Manager   376
 5 Product Manager             323
 6 Project Engineer            317
 7 Marketing Manager           315
 8 Full Stack Engineer         304
 9 Back end Developer          242
10 Front end Developer         239
# ℹ 119 more rows

4.4 Boxplots

Code
ggplot(salary_final, aes(x = Country, y = Salary, fill = Race)) +
  geom_boxplot() +
  scale_fill_viridis(discrete = TRUE) +
  stat_summary(fun = "median", geom = "point", shape = 18, size = 3, color = "red", position = position_dodge(width = 0.75)) +
  labs(title = "Salary Distribution by Country and Race",
       x = "Country",
       y = "Salary") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))  

5. Daten Aufbereiten

(Tests der Thesen gibt uns die Antwort darauf wie die Daten aufbereitet werden müssen)

5.1 Jobs

Da in dem Datensatz teilweise Jobs nur einmalig vertreten sind, kann ein erhebliches Stichproben-Bias verursacht werden. Da das mittlere Einkommen ein wichtiges Merkmal in unserer explorativen Datenanalyse darstellt und mindestens 30 Einträge für eine aussagekräftige Stichprobe nötig sind, haben wir uns dazu entschlossen alle Einträge mit N<30 bei der Anzahl der Jobtitel (N) abzuschneiden.

Code
filtered_data <- salary_final %>%
  group_by(Job.Title) %>%
  summarise(job_count = n()) %>%
  filter(job_count > 30) %>%
  inner_join(salary_final, by = "Job.Title")

print(filtered_data)
# A tibble: 6,398 × 11
   Job.Title   job_count   Age Gender Education.Level Years.Of.Experience Salary
   <chr>           <int> <dbl> <chr>            <dbl>               <dbl>  <dbl>
 1 Back end D…       242    33 Female               2                   5 110000
 2 Back end D…       242    32 Male                 1                   4  95000
 3 Back end D…       242    26 Female               2                   3  90000
 4 Back end D…       242    26 Female               2                   2  70000
 5 Back end D…       242    24 Female               1                   1  60000
 6 Back end D…       242    26 Female               2                   3  90000
 7 Back end D…       242    24 Female               2                   1  60000
 8 Back end D…       242    34 Male                 2                   6 125000
 9 Back end D…       242    29 Female               1                   3  85000
10 Back end D…       242    23 Male                 1                   1  55000
# ℹ 6,388 more rows
# ℹ 4 more variables: Country <chr>, Race <chr>, Senior <dbl>, SalaryKat <fct>
Code
job_title_count <- table(filtered_data$Job.Title)
print(job_title_count)

         Back end Developer   Content Marketing Manager 
                        242                          73 
               Data Analyst              Data Scientist 
                        391                         515 
  Digital Marketing Manager    Director of Data Science 
                         52                          57 
             Director of HR       Director of Marketing 
                         69                          88 
          Financial Analyst           Financial Manager 
                         53                         139 
        Front end Developer         Front End Developer 
                        239                          31 
        Full Stack Engineer               HR Generalist 
                        304                         104 
Human Resources Coordinator     Human Resources Manager 
                         50                         152 
          Marketing Analyst       Marketing Coordinator 
                        144                         167 
         Marketing Director           Marketing Manager 
                         65                         315 
         Operations Manager            Product Designer 
                        122                          80 
            Product Manager   Product Marketing Manager 
                        323                          70 
           Project Engineer             Project Manager 
                        317                          34 
               Receptionist           Research Director 
                         57                          75 
         Research Scientist             Sales Associate 
                        119                         212 
             Sales Director             Sales Executive 
                         62                          38 
              Sales Manager        Sales Representative 
                         58                          81 
         Software Developer           Software Engineer 
                        186                         809 
  Software Engineer Manager               Web Developer 
                        376                         129 
Code
job_title_count <- table(filtered_data$Job.Title)
job_title_df <- data.frame(Job_Title = names(job_title_count), Frequency = as.numeric(job_title_count))

ggplot(job_title_df, aes(x = Job_Title, y = Frequency)) +
  geom_bar(stat = "identity", fill = viridis(2)[1], color = "black") +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Frequency of Unique Job Titles",
       x = "Job Titles",
       y = "Frequency") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Auf min 30 Jobhäufigkeiten angepasst.

Code
job_title_count_filtered <- table(filtered_data$Job.Title)
cat(paste(names(job_title_count_filtered), ":", job_title_count_filtered, "\n"))
Back end Developer : 242 
 Content Marketing Manager : 73 
 Data Analyst : 391 
 Data Scientist : 515 
 Digital Marketing Manager : 52 
 Director of Data Science : 57 
 Director of HR : 69 
 Director of Marketing : 88 
 Financial Analyst : 53 
 Financial Manager : 139 
 Front end Developer : 239 
 Front End Developer : 31 
 Full Stack Engineer : 304 
 HR Generalist : 104 
 Human Resources Coordinator : 50 
 Human Resources Manager : 152 
 Marketing Analyst : 144 
 Marketing Coordinator : 167 
 Marketing Director : 65 
 Marketing Manager : 315 
 Operations Manager : 122 
 Product Designer : 80 
 Product Manager : 323 
 Product Marketing Manager : 70 
 Project Engineer : 317 
 Project Manager : 34 
 Receptionist : 57 
 Research Director : 75 
 Research Scientist : 119 
 Sales Associate : 212 
 Sales Director : 62 
 Sales Executive : 38 
 Sales Manager : 58 
 Sales Representative : 81 
 Software Developer : 186 
 Software Engineer : 809 
 Software Engineer Manager : 376 
 Web Developer : 129 

5.2 Job Typen

5.2.1 Anzahl der technischen / administrativen Jobs

Im Folgenden werden Jobs auf Basis Ihrer Jobtitel in technische und adminisztrative Kategoerien unterteilt. Danach werden die Datensätze “technische_jobs” und “admin_Jobs” erstellt.

Code
# Filtern nach technischen Jobs
technische_jobs <- filtered_data[grep("data|engineer|developer|analyst|scientist", tolower(filtered_data$Job.Title)), ]

# Filtern nach wirtschaftlichen/administrativen Jobs
admin_jobs <- filtered_data[grep("associate|director|manager|sales|coordinator|generalist|receptionist|designer", tolower(filtered_data$Job.Title)), ]

# Beispiel für die Ausgabe der ersten paar Zeilen der gefilterten Daten
head(technische_jobs)
# A tibble: 6 × 11
  Job.Title    job_count   Age Gender Education.Level Years.Of.Experience Salary
  <chr>            <int> <dbl> <chr>            <dbl>               <dbl>  <dbl>
1 Back end De…       242    33 Female               2                   5 110000
2 Back end De…       242    32 Male                 1                   4  95000
3 Back end De…       242    26 Female               2                   3  90000
4 Back end De…       242    26 Female               2                   2  70000
5 Back end De…       242    24 Female               1                   1  60000
6 Back end De…       242    26 Female               2                   3  90000
# ℹ 4 more variables: Country <chr>, Race <chr>, Senior <dbl>, SalaryKat <fct>
Code
head(admin_jobs)
# A tibble: 6 × 11
  Job.Title    job_count   Age Gender Education.Level Years.Of.Experience Salary
  <chr>            <int> <dbl> <chr>            <dbl>               <dbl>  <dbl>
1 Content Mar…        73    30 Female               1                   3  55000
2 Content Mar…        73    27 Female               2                   4  80000
3 Content Mar…        73    27 Female               2                   4  80000
4 Content Mar…        73    27 Female               2                   4  80000
5 Content Mar…        73    27 Female               2                   4  80000
6 Content Mar…        73    27 Female               2                   4  80000
# ℹ 4 more variables: Country <chr>, Race <chr>, Senior <dbl>, SalaryKat <fct>
Code
# Anzahl der technischen Jobs
anzahl_technische_jobs <- nrow(technische_jobs)
cat("Anzahl der technischen Jobs:", anzahl_technische_jobs, "\n")
Anzahl der technischen Jobs: 3912 
Code
# Anzahl der administrativen Jobs
anzahl_admin_jobs <- nrow(admin_jobs)
cat("Anzahl der administrativen Jobs:", anzahl_admin_jobs, "\n")
Anzahl der administrativen Jobs: 2919 

Zu erkennen ist hier, dass es detlich mehr technische Jobs als administraive Jobs in diesem Datensatz gibt.

???? notwenig nochmal zu wissen wie viele insgesamt in filtered data sind????

Code
# Anzahl der Zeilen (Werte) in filtered_data
anzahl_werte_filtered_data <- nrow(filtered_data)

# Anzeigen der Anzahl der Werte
cat("Anzahl der Werte in filtered_data:", anzahl_werte_filtered_data, "\n")
Anzahl der Werte in filtered_data: 6398 

Insgesamt gibt es in dem gefilterten Datensatz 6398 Einträge, was bedeutet, dass ungefähr 60% technische Jobs und 40% administrative Jobs sind.

Nun wird nochmal der gefilterte Datensatz mit der Summe von “anzahl_technische_jobs” und “anzahl_administraive Jobs” verglichen.

Code
anzahl_jobs <- anzahl_technische_jobs + anzahl_admin_jobs
cat(anzahl_jobs)
6831

Zu erkennen ist hier, dass es zwei unterschiedliche Werte für die Beiden Datensätze gibt.

Wir vermuten, dass einige Jobs doppelt gezählt werden. Dies würde erklären, dass deutlich mehr Einträge in “anzahl_jobs” sind. Unser Lösungsvorschlag wäre hier, dass wir den Jobs IDs geben.

5.2.1.1 Lösungsansatz 1

Der erste Lösungsansatz sieht wie folgt aus:

Die jobs werden basierend auf bestimmten Namen ( data, enginner etc. ) gefiltert und alle Duplikate werden entfernt. Das Ergebnis ist nun ein neuer Datensatz “filtered_data_neu” in dem alle Zeilen außer, die technischen und administrativen Jobs enthält.

Code
filtered_data$ID <- 1:nrow(filtered_data)

technische_jobs2 <- unique(filtered_data[grep("data|engineer|developer|analyst|scientist", tolower(filtered_data$Job.Title)), ])

admin_jobs2 <- unique(filtered_data[grep("associate|director|manager|sales|coordinator|generalist|receptionist|designer", tolower(filtered_data$Job.Title)), ])

ids_technische_jobs <- filtered_data$ID[filtered_data$Job.Title %in% technische_jobs2$Job.Title]
ids_admin_jobs <- filtered_data$ID[filtered_data$Job.Title %in% admin_jobs2$Job.Title]

# Entferne die entsprechenden Zeilen aus filtered_data
filtered_data_neu <- filtered_data[!(filtered_data$ID %in% c(ids_technische_jobs, ids_admin_jobs)), ]

# Beispiel für die Ausgabe der ersten paar Zeilen der gefilterten Daten
head(filtered_data_neu)
# A tibble: 0 × 12
# ℹ 12 variables: Job.Title <chr>, job_count <int>, Age <dbl>, Gender <chr>,
#   Education.Level <dbl>, Years.Of.Experience <dbl>, Salary <dbl>,
#   Country <chr>, Race <chr>, Senior <dbl>, SalaryKat <fct>, ID <int>
Code
anzahl_technische_jobs2 <- nrow(technische_jobs2)
cat("Anzahl der technischen Jobs2:", anzahl_technische_jobs2, "\n")
Anzahl der technischen Jobs2: 3912 
Code
anzahl_admin_jobs2 <- nrow(admin_jobs2)
cat("Anzahl der administrativen Jobs2:", anzahl_admin_jobs2, "\n")
Anzahl der administrativen Jobs2: 2919 

Es scheint als würde dieser Lösungsansatz nicht funktionieren, da der neue Datensatz keine Einträge enthält.

5.2.1.2 Lösungsansatz 2

Der zweite Lösungsansatz zum Problem der Klassifizierung der verschiedenen Job Typen kann gelöst werden, indem die beiden Jobs nicht in 2 Tabellen unterteilt werden, sondern Jede Zeile einen Wert des entsprechenden Jobs Typs zugeordnet wird.

Code
filtered_data$job_type <- ifelse(
    grepl("data|engineer|developer|analyst|scientist", tolower(filtered_data$Job.Title)),
    0, # 0 für technische Jobs
    ifelse(
        grepl("associate|director|manager|sales|coordinator|generalist", tolower(filtered_data$Job.Title)),
        1, # 1 für administrative Jobs
        NA  # NA für alle anderen
    )
)

total_rows <- nrow(filtered_data)
count_job_types <- table(filtered_data$job_type, useNA = "ifany")

print(paste("Gesamtanzahl der Zeilen im Datensatz:", total_rows))
[1] "Gesamtanzahl der Zeilen im Datensatz: 6398"
Code
print("Anzahl der Zeilen für jede job_type-Ausprägung:")
[1] "Anzahl der Zeilen für jede job_type-Ausprägung:"
Code
print(count_job_types)

   0    1 <NA> 
3912 2349  137 

Es wird eine neue Spalte namens “job_type” erstellt. Diese Spalte wird nun mit Werten gefüllt. Der Wert = für Zielen mit technischen Jobs und 1 für administrative Jobs. NA erhalten alle anderen Jobtypen.

Nun werden die eben gefundenen NAs in einen neuen Datensatz geschrieben.

Code
na_job_type_rows <- subset(filtered_data, is.na(job_type))

na_job_type_rows
# A tibble: 137 × 13
   Job.Title   job_count   Age Gender Education.Level Years.Of.Experience Salary
   <chr>           <int> <dbl> <chr>            <dbl>               <dbl>  <dbl>
 1 Product De…        80    33 Male                 2                   6  90000
 2 Product De…        80    43 Female               3                  18 140000
 3 Product De…        80    45 Female               3                  15 150000
 4 Product De…        80    45 Female               3                  15 150000
 5 Product De…        80    44 Female               3                  15 150000
 6 Product De…        80    44 Female               3                  15 150000
 7 Product De…        80    27 Male                 1                   3  60000
 8 Product De…        80    27 Male                 1                   3  60000
 9 Product De…        80    27 Male                 1                   3  60000
10 Product De…        80    27 Male                 1                   3  60000
# ℹ 127 more rows
# ℹ 6 more variables: Country <chr>, Race <chr>, Senior <dbl>, SalaryKat <fct>,
#   ID <int>, job_type <dbl>

Das Ergebnis dieser Abfrage ist eine Tabelle, welche nur aus Product Designer % Receptionist besteht. Diese werden nun den adminsitrativen Jobs hinzugefügt.

Code
filtered_data$job_type[filtered_data$Job.Title %in% c("Product Designer", "Receptionist")] <- 1

subset(filtered_data, Job.Title %in% c("Product Designer", "Receptionist"))
# A tibble: 137 × 13
   Job.Title   job_count   Age Gender Education.Level Years.Of.Experience Salary
   <chr>           <int> <dbl> <chr>            <dbl>               <dbl>  <dbl>
 1 Product De…        80    33 Male                 2                   6  90000
 2 Product De…        80    43 Female               3                  18 140000
 3 Product De…        80    45 Female               3                  15 150000
 4 Product De…        80    45 Female               3                  15 150000
 5 Product De…        80    44 Female               3                  15 150000
 6 Product De…        80    44 Female               3                  15 150000
 7 Product De…        80    27 Male                 1                   3  60000
 8 Product De…        80    27 Male                 1                   3  60000
 9 Product De…        80    27 Male                 1                   3  60000
10 Product De…        80    27 Male                 1                   3  60000
# ℹ 127 more rows
# ℹ 6 more variables: Country <chr>, Race <chr>, Senior <dbl>, SalaryKat <fct>,
#   ID <int>, job_type <dbl>
Code
total_rows <- nrow(filtered_data)
count_job_types <- table(filtered_data$job_type, useNA = "ifany")

print(paste("Gesamtanzahl der Zeilen im Datensatz:", total_rows))
[1] "Gesamtanzahl der Zeilen im Datensatz: 6398"
Code
print("Anzahl der Zeilen für jede job_type-Ausprägung:")
[1] "Anzahl der Zeilen für jede job_type-Ausprägung:"
Code
print(count_job_types)

   0    1 
3912 2486 

Nun ist das Klassifizierungsproblem gelöst. Aufgrund dessen können jetzt auch Diegramme über Job_types ausgewertet werden.

5.3 Zugewanderte ( Expats ) & Einheimische

Im folgenden werden einige Boxplots erstellt.

5.3.1 Years of Experience vs. Gender

Code
ggplot(filtered_data, aes(x = factor(Gender), y = Years.Of.Experience, fill = Gender)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Boxplot: Years of Experience vs. Gender",
       x = "Gender",
       y = "Years of Experience",
       fill = "Gender") +
  theme_minimal()

5.3.2 Years of Experience vs. Gender (China)

Code
library(ggplot2)

data_china <- subset(filtered_data, Country == "China")

ggplot(data_china, aes(x = factor(Gender), y = Years.Of.Experience, fill = Gender)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Boxplot: Years of Experience vs. Gender (China)",
       x = "Gender",
       y = "Years of Experience",
       fill = "Gender") +
  theme_minimal()

5.3.3 Years of Experience vs. Gender( USA)

Code
library(ggplot2)

data_usa <- subset(filtered_data, Country == "USA")

ggplot(data_usa, aes(x = factor(Gender), y = Years.Of.Experience, fill = Gender)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Boxplot: Years of Experience vs. Gender (USA)",
       x = "Gender",
       y = "Years of Experience",
       fill = "Gender") +
  theme_minimal()

5.3.4 Salary vs. Gender ( China)

Code
library(ggplot2)

data_china <- subset(filtered_data, Country == "China")

ggplot(data_china, aes(x = factor(Gender), y = Salary, fill = Gender)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Boxplot: Salary vs. Gender (China)",
       x = "Gender",
       y = "Salary",
       fill = "Gender") +
  theme_minimal()

5.3.5 Salary vs. Gender (USA)

Code
library(ggplot2)

data_usa <- subset(filtered_data, Country == "USA")

ggplot(data_usa, aes(x = factor(Gender), y = Salary, fill = Gender)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Boxplot: Salary vs. Gender (USA)",
       x = "Gender",
       y = "Salary",
       fill = "Gender") +
  theme_minimal()

Nach intensiven vergleichen der Grafiken, bezüglich der Salary ,stellt sich nun die Frage:

Ist die Gender-Pay-Gap in China doch Größer, da der größte Faktor für die Salary die Years of Experience sind?

Hierzu werden die Korrelationen errechnet.

5.3.6 Korrelationen zwischen den Spalten

Code
correlation_salary_experience <- cor(filtered_data$Salary, filtered_data$Years.Of.Experience)

cat("Die Korrelation zwischen Salary und Years.Of.Experience ist:", correlation_salary_experience, "\n")
Die Korrelation zwischen Salary und Years.Of.Experience ist: 0.8103542 
Code
correlation_salary_education <- cor(filtered_data$Salary, filtered_data$Education.Level, use = "complete.obs")

cat("Die Korrelation zwischen Salary und Education.Level ist:", correlation_salary_education, "\n")
Die Korrelation zwischen Salary und Education.Level ist: 0.6374551 
Code
correlation_salary_age <- cor(filtered_data$Salary, filtered_data$Age, use = "complete.obs")

cat("Die Korrelation zwischen Salary und Age ist:", correlation_salary_age, "\n")
Die Korrelation zwischen Salary und Age ist: 0.7291603 
Code
correlation_experience_age <- cor(filtered_data$Years.Of.Experience, filtered_data$Age, use = "complete.obs")

cat("Die Korrelation zwischen Years.Of.Experience und Age ist:", correlation_experience_age, "\n")
Die Korrelation zwischen Years.Of.Experience und Age ist: 0.9363709 
Code
correlation_seniority_experience <- cor(filtered_data$Senior, filtered_data$Years.Of.Experience, use = "complete.obs")

cat("Die Korrelation zwischen Seniority und Years.Of.Experience ist:", correlation_seniority_experience, "\n")
Die Korrelation zwischen Seniority und Years.Of.Experience ist: 0.3192657 

Das Ergebnis der Korrelationen:

  • Von Salary und Years.of.experience ist es 0.81.

  • Von Salary und Age ist es 0.73 und die

  • von Age und Years.Of.Experience ist es 0.93.

Nun stellt sich folgende Frage:

Wie kommt es zu so einem großen Unterschied Zwischen den Werten im Vergleich zu Salary, obwohl sie doch eine starke Korrelation zueinadner haben?

Mögliche Antworten auf diese Frage wären:

Verteilung der Daten: Es ist möglich, dass die Verteilung der Daten in den Variablen “Age” und “Years.Of.Experience” anders ist als in der Variable “Salary”. Wenn die Daten in “Age” und “Years.Of.Experience” breiter gestreut sind, kann dies zu einer geringeren Korrelation führen, selbst wenn eine starke lineare Beziehung besteht.

Nicht-lineare Beziehung: Die Korrelation misst nur lineare Beziehungen. Wenn die Beziehung zwischen “Age” und “Years.Of.Experience” nicht linear ist, könnte dies zu einem niedrigeren Korrelationswert führen.

Ausreißer: Das Vorhandensein von Ausreißern kann die Korrelation beeinflussen. Wenn es Ausreißer in einer der Variablen gibt, kann dies den Korrelationswert beeinträchtigen.

Stichprobengröße: Bei kleineren Stichproben können Korrelationswerte instabiler sein.

Nun werden die Daten auf technische und administrative Jobs gefiltert, anschließend werden die Gehälter der beiden Gruppen ausgegeben und in einem Diagramm ausgeben und verglichen.

Code
technische_jobs <- subset(filtered_data, job_type == 0)
admin_jobs <- subset(filtered_data, job_type == 1)

average_salaries_technical <- mean(technische_jobs$Salary, na.rm = TRUE)

average_salaries_admin <- mean(admin_jobs$Salary, na.rm = TRUE)

all_average_salaries <- data.frame(Job.Type = c("technisch", "admin"),
                                   Average.Salary = c(average_salaries_technical, average_salaries_admin))

ggplot(all_average_salaries, aes(x = Job.Type, y = Average.Salary, fill = Job.Type)) +
  geom_bar(stat = "identity", position = "dodge", alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Durchschnittliche Gehälter nach Jobtyp",
       x = "Jobtyp",
       y = "Durchschnittliches Gehalt") +
  theme_minimal() +
  scale_y_continuous(labels = scales::comma)  

Obwohl in den Admin Jobs auch direktoren und Manager vertreten sind, nehmen wir an, dass ein Manager ein Job Titel, wie “Projekt Manager” und nicht “Manager für Projekte” hat und dieser Titel in unserem Datensatz Director ist (Thema Führungsposition).

Unsere Untersuchungen haben ergeben, dass wir die Daten für unsere Explorative Datenanalyse aber auch für die folgenden Regressionen neu aufbereiten müssen.

Dazu wird untersucht::

Unterscheidet sich ein native und expat im jeweiligen Land? Welche Annahmen sind dafür nötig? Hier die Annahme das “White” generell nicht ausgewandert ist da wir hier Länder mit ähnlicher Kultur und Salary haben.

Code
ggplot(filtered_data, aes(x = Country, fill = Race)) +
  geom_bar(position = "dodge") +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Count of Races in Each Country",
       x = "Country",
       y = "Count") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Dafür wird eine neue Spalte eingefügt, die mit numerischen werten arbeitet. 0 steht für Einheimische und 1 für einen Expat. Den Wert null erhalten alle zeilen bei denen wir folgende Übereinstimmung feststellen: African American (USA) White (Canada, USA, UK, Australia) Chinese (China) Australian(Australia) Welsh (UK) jede andere Race ist ja dementsprechend Expat und erhält eine 1 in der Spalte Expat.

????????

Code
filtered_data$Expat <- 0

expat_conditions <- list(
  filtered_data$Race == "African American" & filtered_data$Country == "USA",
  filtered_data$Race %in% c("White", "Chinese", "Australian", "Welsh") &
    filtered_data$Country %in% c("Canada", "USA", "UK", "Australia"),
  TRUE
)

filtered_data$Expat <- ifelse(expat_conditions[[1]] | expat_conditions[[2]], 0, 
                               ifelse(expat_conditions[[3]], 1, NA))

head(filtered_data)
# A tibble: 6 × 14
  Job.Title    job_count   Age Gender Education.Level Years.Of.Experience Salary
  <chr>            <int> <dbl> <chr>            <dbl>               <dbl>  <dbl>
1 Back end De…       242    33 Female               2                   5 110000
2 Back end De…       242    32 Male                 1                   4  95000
3 Back end De…       242    26 Female               2                   3  90000
4 Back end De…       242    26 Female               2                   2  70000
5 Back end De…       242    24 Female               1                   1  60000
6 Back end De…       242    26 Female               2                   3  90000
# ℹ 7 more variables: Country <chr>, Race <chr>, Senior <dbl>, SalaryKat <fct>,
#   ID <int>, job_type <dbl>, Expat <dbl>

Ausgabe hier sind nun die ersten Zeilen der aktualisierten Version von “filtered_data” indem die Spalte “Expat” basierend auf den oben genannten Kriterien befüllt wurde.

6. Thesen

Aus den überlegungen der Tests und der Vorarbeit wurden folgende Thesen formuliert.

Der folgende Absatz wird in unterschiedliche Teilabschnitte geteilt, um eine gute Leserlichkeit zu erreichen.

6.1 Genderpaygap

  1. Männer verdienen mehr als Frauen
  2. Die Differenz der Salary zwischen den Geschlechtern ist in China höher als in den westlichen Ländern.
  3. Männer haben im Durchschnitt mehr Yrs of Experience als Frauen -> Lässt sich die Genderpaygap auf die Yrs of Exp übertragen? Und gilt dies auch für China

6.1.1 Männer verdienen mehr als Frauen

Zunächst stellt sich die Frage, ob Männer mehr verdienen als Frauen. Hierzu wird ein Boxplot verwendet.

Code
ggplot(filtered_data, aes(x = factor(Gender), y = Salary, fill = Gender)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Boxplot: Salary vs. Gender",
       x = "Gender",
       y = "Salary",
       fill = "Gender") +
  theme_minimal()

Anhand des Boxplots ist zu erkennen, dass der Median der Männer deutlich höher, als der Median der Frauen ist. Aufgrund dieser Tatsache, lässt sich sagen, dass diese Aussage korrekt ist.

6.1.2.: Die Differenz der Salary zwischen den Geschlechtern ist in China höher als in den westlichen Ländern. Hier alle westlichen Länder hinzufügen

Um diese These zu beantworten werrden zunächst Die Erfahrungsjahre zwischen China und der USA verglichen. Anschließend werden die Gehälter verglichen. Nebenbei haben die Boxplots immer eine Differenzierung zwischen Männern und Frauen um den Unterschied darzustellen.

Zu Beantwortung dieser These werden Boxplots verwendet.

Code
data_usa <- subset(filtered_data, Country == "USA")

ggplot(data_usa, aes(x = factor(Gender), y = Years.Of.Experience, fill = Gender)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Boxplot: Years of Experience vs. Gender (USA)",
       x = "Gender",
       y = "Years of Experience",
       fill = "Gender") +
  theme_minimal()

Code
data_china <- subset(filtered_data, Country == "China")

ggplot(data_china, aes(x = factor(Gender), y = Years.Of.Experience, fill = Gender)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Boxplot: Years of Experience vs. Gender (China)",
       x = "Gender",
       y = "Salary",
       fill = "Gender") +
  theme_minimal()

Anhand der ersten beiden Boxplots ist zu erkennen, dass Männer in der USA deutlich mehr Berufserfahrung haben als Frauen. Wohin gegen der Unterschied in China kaum zu erkennen ist.

Code
data_usa <- subset(filtered_data, Country == "USA")

ggplot(data_usa, aes(x = factor(Gender), y = Salary, fill = Gender)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Boxplot: Years of Experience vs. Gender (USA)",
       x = "Gender",
       y = "Years of Experience",
       fill = "Gender") +
  theme_minimal()

Code
data_china <- subset(filtered_data, Country == "China")

ggplot(data_china, aes(x = factor(Gender), y = Salary, fill = Gender)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Boxplot: Salary vs. Gender (China)",
       x = "Gender",
       y = "Salary",
       fill = "Gender") +
  theme_minimal()

Durch die letzen beiden Boxplots ist zu erkennen, dass der Unterschied im durchschnittlichen Gehalt in China und der USA mit dem bloßen Auge nicht zu erkennen ist.
Unter Anbetracht der oberen beiden Boxplots ist jedoch, wie bereits erwähnt, ein deutlicher Unterschied zwischen den Geschlechtern im Bezug auf die Berufsaerfahrung zu erkennen.

Code
correlation_salary_experience <- cor(filtered_data$Salary, filtered_data$Years.Of.Experience)

cat("Die Korrelation zwischen Salary und Years.Of.Experience ist:", correlation_salary_experience, "\n")
Die Korrelation zwischen Salary und Years.Of.Experience ist: 0.8103542 

Aus den obigen Test ist außerdem hervor gegangen, dass die Berufserfahrung eine hohe Korrelation zu dem Gehalt hat.

Deswegen lässt sich trotzdem sagen, dass diese These korrekt ist.

6.1.3.: Männer haben im Durchschnitt mehr Berufserfahrung als Frauen

Code
ggplot(filtered_data, aes(x = factor(Gender), y = Years.Of.Experience, fill = Gender)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Boxplot: Years of Experience vs. Gender",
       x = "Gender",
       y = "Years of Experience",
       fill = "Gender") +
  theme_minimal()

Die These ist korrekt, wie anhand des obigen Boxplots zu erkennen ist. Der Median liegt bei den Männern höher, als bei den Frauen.

6.2 Zugewanderte Menschen verdienen mehr als einheimische Menschen

Unsere Untersuchungen haben Ergeben das wir die Daten für unsere Explorative Datenanalyse aber auch die Regression neu aufbereiten müssen.

Dazu suchen wir: unterscheide ich einen native und expat im jeweiligen Land. Welche annahmen sind dafür nötig? Hier die annahme das White generell nicht ausgewandert ist da wir hier länder mit ähnlicher kultur und salary haben

6.2.1.: Alle Ethnizitäten je Land

Code
ggplot(filtered_data, aes(x = Country, fill = Race)) +
  geom_bar(position = "dodge") +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Count of Races in Each Country",
       x = "Country",
       y = "Count") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Hier ist ist zu erkennen. welche Ethnizitäten wir in den unterschiedlichen Ländern haben. So ist zu erkennen, dass wir nie mehr als vier Ethnizitäten pro Land haben.

6.2.2.: Gesamtbetrachtung

Code
ggplot(filtered_data, aes(x = as.factor(Expat), y = Salary, fill = factor(Expat))) +
  geom_boxplot() +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Vergleich der Gehälter von Zugewanderten und Einheimischen",
       x = "Expat",
       y = "Gehalt") +
  scale_x_discrete(labels = c("Einheimische (0)", "Zugewanderte (1)")) +
  theme_minimal()

Aus diesem Diagramm geht hervor, dass kein Unterschied vorerst zu erkennen ist.

Code
mean_salary_expat <- mean(filtered_data$Salary[filtered_data$Expat == 1], na.rm = TRUE)
mean_salary_expat
[1] 116928.1
Code
mean_salary_native <- mean(filtered_data$Salary[filtered_data$Expat == 0], na.rm = TRUE)
mean_salary_native
[1] 116572.5

Auch nach Darstellung der Mittelwerte istr kein wirklicher Unterschied zu erkennen.

Deswegen wird die These verworfen, da es offensichtlich keine Unterschiede gibt.

6.3 Gibt es einen Unterschied im Gehalt zwischen den verschiedenen Bildungsniveaus?

Vorab muss erwähnt werden, dass ohne ein Mindestmaß an Bildung keine weitere Gehaltsentwicklung möglich ist.

Das sind die Bedeutungen der verschiedenen Bildungsniveaus:

0 = High School Abschluss

1 = Bachelor

2 = Master

3 = Doctor

Um diese These zu beantworten sind wir auf verschiedene Lösungsansätze gekommen, die uns helfen könnten:

  1. Deskriptive Statistiken: Es könnten Quantile oder Perzentile des Gehalts für jeden Bildungsniveau berechnet berechnet werden. Dies könnte einen Überblick über die Verteilung der Gehälter bieten und zeigt potenzielle Grenzwerte.

  2. Boxplots pro Bildungsniveau: Es könnten Boxplots für jeden Bildungsniveau erstellt werden, um die Verteilung der Gehälter visuell zu vergleichen. Dies könnte unterstützend wirken, um Ausreißer und Unterschiede im Bildungsniveau zu identifizieren.

  3. Visualisierungen: Es besteht die Möglichkeit verschiedene Visualiersierungen, wie Scatterplots oder Liniendiagramme zu erstellen, um Trends oder Muster zwischen Gehalt und Bildungsniveau zu erkennen.

6.3.1.: Desktiptive Statistiken:

Hierzu werden erst die Daten brechnet und anschließend für die Grafik “ge-reshaped”.

Code
library(ggplot2)
library(dplyr)

# Daten berechnen
salary_percentiles <- filtered_data %>%
  group_by(Education.Level) %>%
  summarise(`10th Percentile` = quantile(Salary, probs = 0.1, na.rm = TRUE),
            `25th Percentile` = quantile(Salary, probs = 0.25, na.rm = TRUE),
            `50th Percentile (Median)` = quantile(Salary, probs = 0.5, na.rm = TRUE),
            `75th Percentile` = quantile(Salary, probs = 0.75, na.rm = TRUE),
            `90th Percentile` = quantile(Salary, probs = 0.9, na.rm = TRUE))

salary_percentiles_long <- salary_percentiles %>%
  tidyr::pivot_longer(cols = -Education.Level, names_to = "Percentile", values_to = "Salary")

ggplot(salary_percentiles_long, aes(x = Education.Level, y = Salary, fill = Percentile)) +
  geom_bar(stat = "identity", position = "dodge", alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Perzentile des Gehalts nach Bildungsniveau",
       x = "Bildungsniveau",
       y = "Gehalt",
       fill = "Perzentil") +
  theme_minimal()

In dem gruppierten Balkendiagramm kann erkannt werden, dass die unterschiedlichen Perzentile stets mit dem Bildungsniveau zusammen ansteigen.

Code
average_salary_education <- aggregate(Salary ~ Education.Level, data = filtered_data, FUN = mean, na.rm = TRUE)

average_salary_education
  Education.Level    Salary
1               0  34511.62
2               1  97042.04
3               2 129983.77
4               3 165796.75

Die oben gestellte Aussage wird auch nochmal bestätigt, durch die Ausgabe der “avarage Salary”. Hier ist zu erkennen, dass das durchschnittliche Gehalt höher ist, je höher das Bildungsniveau ist.

6.3.2.: Boxplots pro Bildungsniveau:

Code
filtered_data <- filtered_data %>%
  mutate(Education.Level = factor(Education.Level, levels = unique(sort(Education.Level))))

ggplot(filtered_data, aes(x = reorder(factor(Education.Level), Salary, FUN = median), y = Salary)) +
  geom_boxplot(color = "black", fill = viridis(2)[2]) +
  labs(title = "Boxplot des Gehalts nach Bildungsniveau",
       x = "Bildungsniveau",
       y = "Gehalt") +
  theme_minimal()

Auch in dem Balkendiagramm ist, genau wie oben, zu erkennen, dass der Median stets höher ist, je höher das Bildungsniveau geht.

6.3.3.: Visualisierungen:

Code
filtered_data <- filtered_data %>%
  mutate(Education.Level = factor(Education.Level, levels = unique(sort(Education.Level))))

ggplot(filtered_data, aes(x = reorder(factor(Education.Level), Salary, FUN = median), y = Salary)) +
  geom_point() + 
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Gehalt nach Bildungslevel",
       x = "Bildungslevel",
       y = "Gehalt") +
  theme_minimal()

Der folgende Code erstellt ein Liniendiagramm, dass das Gehalt in Abhängigkeit vom Bildungsniveau darstellt. Zunächst wird das Bildungsniveau neu angeordnet und danach das Liniendiagramm erstellt.

Code
filtered_data$Education.Level <- factor(filtered_data$Education.Level, levels = c("0", "1", "2", "3"))

ggplot(filtered_data, aes(x = Education.Level, y = Salary, group = 1)) +
  geom_line() +
  stat_summary(fun.y = median, geom = "point", size = 3, color = "red") +
  labs(title = "Gehalt nach Bildungslevel",
       x = "Bildungslevel",
       y = "Gehalt") +
  theme_minimal()
Warning: The `fun.y` argument of `stat_summary()` is deprecated as of ggplot2 3.3.0.
ℹ Please use the `fun` argument instead.

Die roten Punkte zeigen den Medianwert des Gehalts je nach Bildungsniveau. ( bitte jonas nochmal fragen, verstehe ich nicht).

Ohne einen Hochschulabschluss gibt es eine Gehaltsgrenze. Die top 90% ohne Hochschulabschluss fangen bei den unteren 10% mit Hochschulabschluss an aus der Sicht des Gehalts.

Die These kann als Korrekt angesehen werden, da alle Lösungsansätze im Allgemeinen, das gleiche Ergebnis liefern.

6.4 Die technischen Jobs haben ein höheres Gehalt als die administrativen Jobs

6.4.1.: Daten Aufbereiten

Unter dem Punkt “Daten aufbereiten 2” wurden bereits alle Jobs in administrativ und technisch unterteilt.

Zudem werden noch im folgenden alle Werte aus dem Datensatz gefiltert, die den jobtitel “Director” enthalten, da dieser Job nicht eindeutig einer Gruppe zugeordnet werden kann (z.B “Engineering Director”)

Code
filtered_data2 <- filtered_data

director_jobs <- filtered_data2 %>%
  filter(grepl("Director", Job.Title))

filtered_data2 <- filtered_data2 %>%
  anti_join(director_jobs)
Joining with `by = join_by(Job.Title, job_count, Age, Gender, Education.Level,
Years.Of.Experience, Salary, Country, Race, Senior, SalaryKat, ID, job_type,
Expat)`
Code
nrow(director_jobs)
[1] 416
Code
nrow(filtered_data)
[1] 6398
Code
nrow(filtered_data2)
[1] 5982

6.4.2.: Insgesamt

In diesem Abschnitt wird eine Übersicht der durchschnittlichen Gehälter nach der Sortierung der Jobs nach technisch oder administrativ, erstellt. Dafür werden zunächst die Daten gefiltert. Danch werden die durchschnittlichen Gehälter der beiden Jobtypen berechnet. Anschließend werden dann die durchscnittlichen Gehälter in einen Datenrahmen zusammengeführt. Zum Schluss wird dann das Balkendiagramm erstellt.

Code
technische_jobs <- subset(filtered_data, job_type == 0)
admin_jobs <- subset(filtered_data, job_type == 1)

average_salaries_technical <- mean(technische_jobs$Salary, na.rm = TRUE)

average_salaries_admin <- mean(admin_jobs$Salary, na.rm = TRUE)

all_average_salaries <- data.frame(Job.Type = c("technisch", "admin"),
                                   Average.Salary = c(average_salaries_technical, average_salaries_admin))

ggplot(all_average_salaries, aes(x = Job.Type, y = Average.Salary, fill = Job.Type)) +
  geom_bar(stat = "identity", position = "dodge", alpha = 0.7) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Durchschnittliche Gehälter nach Jobtyp",
       x = "Jobtyp",
       y = "Durchschnittliches Gehalt") +
  theme_minimal() +
  scale_y_continuous(labels = scales::comma)

In dem Balkendiagramm ist deutlich zu erkennen, dass das durchscnittliche Gehalt bei technischen Jobs höher ist.

Anschließend werden die Werte der durchschnittlichen Gehälter auch nochmal seperat ohne Grafik ausgegeben:

Code
technische_jobs <- subset(filtered_data, job_type == 0)
admin_jobs <- subset(filtered_data, job_type == 1)

average_salaries_technical <- mean(technische_jobs$Salary, na.rm = TRUE)

average_salaries_admin <- mean(admin_jobs$Salary, na.rm = TRUE)

cat("Durchschnittliches Gehalt für technische Jobs:", average_salaries_technical, "\n")
Durchschnittliches Gehalt für technische Jobs: 126441.3 
Code
cat("Durchschnittliches Gehalt für administrative Jobs:", average_salaries_admin, "\n")
Durchschnittliches Gehalt für administrative Jobs: 101595.3 

Auch hier ist zu erennen, das das dcurchschnittliche Gehalt bei technischen Jobs um rund 20.000 GE höher ist.

6.4.3.: Je Land

Nun wird eine Übersicht der durchschnittlichen Gehälter nach der Sortierung der Jobs, je Land erstellt.

Code
summary_data <- aggregate(Salary ~ Education.Level + Country, data = filtered_data, FUN = median)

ggplot(summary_data, aes(x = Education.Level, y = Salary, fill = Country)) +
  geom_bar(stat = "identity", position = "dodge") +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Median Gehalt nach Bildungslevel und Land", 
       x = "Bildungslevel",
       y = "Median Gehalt",
       fill = "Land") +
  theme_minimal()

These Korrekt, und das Obwohl in den Admin Jobs auch in seltenen Fällen Manager vertreten sind.

Es lässt sich zudem beobachten das Doktoren in Australien ein höheres Gehalt verdienen als in anderen Ländern.

6.5 Data Scientist verdienen aufgrund der hohen Nachfrage der Berufsgruppe im Schnitt mehr als andere Jobgruppen bei gleichbleibender Erfahrung und Abschlussniveau.

6.5.1.: Begründung

Der Beruf des Data Scientist ist laut dem Harvard Business Review der “Sexiest Job of the 21st Century”.

Siehe link:

*https://hbr.org/2012/10/data-scientist-the-sexiest-job-of-the-21st-century

Nach Anbetracht dieser Aussage, stellt sich die Frage, ob gerade das Gehalt von Data Scientisten, zu dieser Aussage führt.

6.5.2.: Datenaufbereitung

Um die These beantworten zu können müssen als erstes ein paar Anpassungen an den Datensatz vorgenommen werden.

Zunächst wird eine Einengung nach Jobs, nach den Stichworten Data, Software, Developer und Egineer durchgeführt. Anschließend werden alle Manager und Direktoren rausgefiltert.

Code
filtered_data3 <- filtered_data %>%
  filter(grepl("Data|Software|Developer|Engineer", Job.Title))

job_title_count <- table(filtered_data3$Job.Title)
job_title_df <- data.frame(Job_Title = names(job_title_count), Frequency = as.numeric(job_title_count))

job_title_df
                   Job_Title Frequency
1         Back end Developer       242
2               Data Analyst       391
3             Data Scientist       515
4   Director of Data Science        57
5        Front end Developer       239
6        Front End Developer        31
7        Full Stack Engineer       304
8           Project Engineer       317
9         Software Developer       186
10         Software Engineer       809
11 Software Engineer Manager       376
12             Web Developer       129
Code
filtered_data3 <- filtered_data3 %>%
  filter(!grepl("Director|Manager", Job.Title))

job_title_count <- table(filtered_data3$Job.Title)
job_title_df <- data.frame(Job_Title = names(job_title_count), Frequency = as.numeric(job_title_count))

job_title_df
             Job_Title Frequency
1   Back end Developer       242
2         Data Analyst       391
3       Data Scientist       515
4  Front end Developer       239
5  Front End Developer        31
6  Full Stack Engineer       304
7     Project Engineer       317
8   Software Developer       186
9    Software Engineer       809
10       Web Developer       129

Anchließend wird, um die Leserlichkeit zu verbessern, eine Aufteilung der Jobs durchgeführt. Hierzu werden die Jobs in eine neue Spalte “data_job” aufgeteilt.

Code
filtered_data3 <- filtered_data3 %>%
  mutate(data_job = ifelse(grepl("Data", Job.Title), 1, 0))
Code
count_0 <- sum(filtered_data3$data_job == 0, na.rm = TRUE)
count_1 <- sum(filtered_data3$data_job == 1, na.rm = TRUE)

cat("Anzahl der Zeilen mit dem Wert 0 bei data_job (Data Scientists & Engineers):", count_0, "\n")
Anzahl der Zeilen mit dem Wert 0 bei data_job (Data Scientists & Engineers): 2257 
Code
cat("Anzahl der Zeilen mit dem Wert 1 bei data_job (Software Engineers & Co):", count_1, "\n")
Anzahl der Zeilen mit dem Wert 1 bei data_job (Software Engineers & Co): 906 

6.5.3.: Balkendiagramm

Um die Übersicht zu verbessern, wird die Berufserfahrung in Quantile eingeteilt. Die Bildungsniveaus hingegen sind ja ebreits in Vier Werte eingeteilt.

Als erstes werden die Quantile der Berufserfahrung berechnet und anschließend ein Balkendiagramm für den Datensatz “data_job” erstellt, um das Gehalt zu vergleichen.

Code
filtered_data4 <- filtered_data3 %>%
  mutate(Experience_Quartile = ntile(Years.Of.Experience, 4))

ggplot(filtered_data4, aes(x = factor(data_job), y = Salary)) +
  stat_summary(fun = "mean", geom = "bar", position = "dodge", fill = viridis(2)[1]) +
  labs(title = "Gehalt nach Data Job",
       x = "Data Job",
       y = "Gehalt (Mittelwert)")

Code
ggplot(filtered_data4, aes(y = Salary, x = factor(Experience_Quartile))) +
  geom_bar(stat = "identity", position = "dodge", aes(fill = factor(data_job))) +
  labs(title = "Quartile der Berufserfahrung nach Gehalt und Jobtyp",
       x = "Quartile der Berufserfahrung",
       y = "Gehalt") +
  theme_minimal() +
  scale_fill_viridis(discrete = TRUE)

Zum Verständnis hier noch einmal die Codes des Bidlungsniveaus

0 = High School Abschluss

1 = Bachelor

2 = Master

3 = Doctor

Code
ggplot(filtered_data4, aes(y = Salary, x = factor(Education.Level))) +
  geom_bar(stat = "identity", position = "dodge", aes(fill = factor(data_job))) +
  scale_fill_viridis(discrete = TRUE) +
  labs(title = "Quartile des Bildungsniveaus nach Gehalt und Jobtyp",
       x = "Quartile des Bildungsniveaus",
       y = "Gehalt") +
  theme_minimal()

Hier ist zu erkennen, dass Data Scientists mehr als Arbeitnehmer aus der Software Enginnering % Co Gruppe. Es muss jedoch beachtet werden, dass die “data- Gruppe” mindetens einen Bachelor besitzt und erst nach einem Master mehr verdient, als ihr Counterpart. Im Bezug auf die Berufserfahrung lässt sich feststellen, dass es in jedem Quantil einen höheres Gehaltsniveau bei der “data-Gruppe” gibt.

Trotzdem lässt sich sagen, dass die These korrekt ist.

6.6 Die Gehälter sind in Ländern mit einem höheren BIP pro Kopf höher

Zum Verständnis sind hier einmal die BIP’s pro Kopf aufgelistet:

Australien 64.813,85 US-Dollar Quelle: Australien - BIP pro Kopf bis 2028 | Statista

Canada 53.246,98 US-Dollar Quelle: Kanada - BIP pro Kopf bis 2028 | Statista

China 12.541,40 US-Dollar Quelle: China - BIP pro Kopf bis 2028 | Statista

UK 48.912,78 US-Dollar Quelle: Großbritannien - BIP pro Kopf bis 2028 | Statista

USA 76.343 US-Dollar Quelle: USA - BIP pro Kopf bis 2028 | Statista

6.6.1.: Aufbereitung

Vorab muss ein wenig Vorarbeit geleistet werden.

Zunächst werden die BIP-Werte den entsprechend Ländern zugewiesen.

Code
filtered_data$BIP_Per_Person <- NA

filtered_data$BIP_Per_Person[filtered_data$Country == "Australia"] <- 64813.85
filtered_data$BIP_Per_Person[filtered_data$Country == "Canada"] <- 53246.98
filtered_data$BIP_Per_Person[filtered_data$Country == "China"] <- 12541.40
filtered_data$BIP_Per_Person[filtered_data$Country == "UK"] <- 48912.78
filtered_data$BIP_Per_Person[filtered_data$Country == "USA"] <- 76343.00
Code
head(filtered_data3)
# A tibble: 6 × 15
  Job.Title    job_count   Age Gender Education.Level Years.Of.Experience Salary
  <chr>            <int> <dbl> <chr>  <fct>                         <dbl>  <dbl>
1 Back end De…       242    33 Female 2                                 5 110000
2 Back end De…       242    32 Male   1                                 4  95000
3 Back end De…       242    26 Female 2                                 3  90000
4 Back end De…       242    26 Female 2                                 2  70000
5 Back end De…       242    24 Female 1                                 1  60000
6 Back end De…       242    26 Female 2                                 3  90000
# ℹ 8 more variables: Country <chr>, Race <chr>, Senior <dbl>, SalaryKat <fct>,
#   ID <int>, job_type <dbl>, Expat <dbl>, data_job <dbl>

6.6.2.: Visualisierung und Berechnung

Mithilfe von Streudiagrammen und Berechnungen wird nun versucht die These zu wiederlegen oder als richtig markieren zu können.

Code
ggplot(filtered_data, aes(x = BIP_Per_Person, y = Salary, color = Country)) +
  geom_point() +
  stat_summary(fun = mean, geom = "point", shape = 23, size = 3, fill = "black") +
  labs(title = "Vergleich von Gehalt und BIP pro Person nach Ländern",
       x = "BIP pro Person",
       y = "Gehalt",
       color = "Land") +
  scale_color_viridis(discrete = TRUE)

Mithilfe dieses Streudiagramm ist wirklich viel zu erkennen. Deswegen werden weitere BErechnungen angestellt.

Zunächst werden die Mittelwerte nach Land berechnet. und anschließend die Mittelwerte nach Land nach Betracht auf das BIP.

Code
mean_salaries_by_country <- filtered_data3 %>%
  group_by(Country) %>%
  summarise(mean_salary = mean(Salary, na.rm = TRUE))

mean_salaries_by_country
# A tibble: 5 × 2
  Country   mean_salary
  <chr>           <dbl>
1 Australia     121610.
2 Canada        125466.
3 China         120395.
4 UK            123564.
5 USA           119265.
Code
mean_salaries_by_country <- filtered_data %>%
  group_by(Country) %>%
  summarise(mean_salary = mean(Salary, na.rm = TRUE),
            BIP_Per_Person = first(BIP_Per_Person))  
mean_salaries_by_country
# A tibble: 5 × 3
  Country   mean_salary BIP_Per_Person
  <chr>           <dbl>          <dbl>
1 Australia     116704.         64814.
2 Canada        118200.         53247.
3 China         117480.         12541.
4 UK            117412.         48913.
5 USA           114209.         76343 

Außerdem wird noch die Korrelation zwischen der Salary und dem Bip Berechnet.

Code
cor(filtered_data$Salary, filtered_data$BIP_Per_Person, use = "complete.obs")
[1] -0.01632912

Es geht hervor, dass es keine große Korrelation ziwschen dem Gehalt und dem BIP gibt.

Nun wird das ganze noch ohne China druchgeführt:

Zunächst wird ein Datensatz ohne China erstellt und anschließend wird die Korrelation erneut berechnet. Zudem wird noch die Anzahl der Datensätze mit dem land “China” in dem neuen Datensatz.

Code
filtered_data_no_china <- filtered_data %>% filter(Country != "China")
Code
cor(filtered_data_no_china$Salary, filtered_data_no_china$BIP_Per_Person, use = "complete.obs")
[1] -0.02614532
Code
count_china <- filtered_data_no_china %>% filter(Country == "China") %>% nrow()
count_china
[1] 0

Anhand der Berechnung und des Streudiagramms lässt sich die These als nicht korrekt beantworten. Es gibt eine negative Korrelation zwischen dem Gehalt, welches ein Arbeitnehmer erhält und dem BIP des jeweiligen Landes. Selbst wenn China aus der Berechnung rausgenommen wird, welches aufgrund der hohen Einwohnerzahl und diversen Wirtschaft ( Sonderverwaltungszonen und Kommunismus) einen sehr niedrigen BIP hat.

Nun stellt sich die Frage, ob eventuell in dem Datensatz bwusst Jobs mit hohem Gehalt gewählt wurden. Oder wurden Werte von spezifischen Firmen, die international tätig sind und gut bezahlen, genommen?

Siehe folgende Links:

*https://de.wikipedia.org/wiki/Politisches_System_der_Volksrepublik_China

*https://de.wikipedia.org/wiki/Sonderverwaltungszone

7. Regressionen

In dem folgenden Absatz werden die Regressionen durchfegührt.

7.1.: Einfache Lineare Regression Gehalt und Arbeitserfahrung

Als erstes wird eine einfache lineare Regression mit dem Gehalt und der Arbeitserfahrung durchgeführt

Die Korrelation von Arbeitserfahtung und Gehalt liegt bei 0.81 weshalb wir uns entscheiden haben diese als Regression zu verwenden. Des weiteren nutzen wir auch das Alter so wie das Bildungsniveau.

Die Korrelation zwischen der Arbeitserfahrung und Gehalt liegt bei 0.81. Deshalb wurde entschieden diese als Regression zu verwenden. Des Weiteren wird auch das Alter, so wie das Bildungsniveau verwendet.

7.1.1.: Korrelationsmatrix

Zunächst wird ein Streudiagramm über die Beziehung zwischen dem Gehalt und der Berufserfahrung erstellt. Außerdem wird eine lineare Regressionsgerade eingefügt, um den Trend besser analysieren zu können.

Code
filtered_data %>%
  ggplot() +
  aes(y = Salary, x = Years.Of.Experience) +
  geom_point(aes(color = Salary), alpha = 0.8) +
  geom_smooth(method = lm, color = "orange") +
  scale_color_viridis(option = "D") +
  scale_y_continuous(labels = scales::comma)
`geom_smooth()` using formula = 'y ~ x'

Anhand dieser Grafik kann gesagt werden, das der Trend deutlich nach oben geht, je mehr Berufserfahrung eine Person hat.

7.1.2.: Datenaufbereitung

Es muss noch etwas an dem Datensatz geändert werden.

Zunächst mpüssen alle Werte, die nicht für die Regression relevant sind, rausgenommen werden. Deswegen werden nur “Salary” und “Years of Experience” behalten.

Code
filtered_data5 <- filtered_data %>%
  select(Salary, Years.Of.Experience)

7.1.2.1 Z-Skalierung

Zuerst wird eine Z-Skalierung von filtered_data_5 durchgeführt.

Die Z-Skalierung ist eine Methode zur Standardisierung von numerischen Variablen. Bei der Z-Skalierung werden alle numerischen Werte mit Ausnahme des Vorhersagewerts (Salary) skaliert, um die Auswirkungen von Ausreißern zu minimieren.

Code
filtered_data5_z <- filtered_data5
filtered_data5_z$Years.Of.Experience <- scale(filtered_data5$Years.Of.Experience)

Ergebnis der Z-Skalierung:

Code
summary(filtered_data5_z)
     Salary       Years.Of.Experience.V1
 Min.   :   550   Min.   :-1.350859     
 1st Qu.: 70000   1st Qu.:-0.850649     
 Median :120000   Median :-0.183702     
 Mean   :116787   Mean   : 0.000000     
 3rd Qu.:160000   3rd Qu.: 0.649981     
 Max.   :250000   Max.   : 4.318187     

Überprüfung der Standardabweichung für Arbeitserfahrung

Code
sd(filtered_data5_z$Years.Of.Experience)
[1] 1

Aufteilung in Test- und Trainingsdaten:

Code
set.seed(007)

filtered_data5_z <- initial_split(filtered_data5_z, prop = 0.8, strata = Years.Of.Experience)

fd5_train <- training(filtered_data5_z)
fd5_test <- testing(filtered_data5_z)

Dieser Code teilt den Datensatz filtered_data5_z in Trainings- und Testdaten auf, um eine lineare Regression durchzuführen. Die Funktion set.seed(007) initialisiert den Zufallszahlengenerator mit einer festen Zahl, um sicherzustellen, dass die Ergebnisse bei jedem Durchlauf reproduzierbar sind. Die Funktion initial_split() aus dem Paket rsample teilt den Datensatz in Trainings- und Testdaten auf. Der Parameter prop = 0,8 gibt an, dass 80% der Daten für das Training verwendet werden sollen, während die restlichen 20% für das Testen verwendet werden. Der Parameter strata = Years.Of.Experience sorgt dafür, dass die Daten nach dem Gehalts-Wert stratifiziert werden, um sicherzustellen, dass die Trainings- und Testdaten eine ähnliche Verteilung von Gehalts-Werten aufweisen. Die Funktion training() extrahiert die Trainingsdaten aus dem aufgeteilten Datensatz, während testing() die Testdaten extrahiert.

7.1.3.: Modell Initialisieren

Code
lm_model <- linear_reg() |> set_engine("lm")

Lineare Regression von Salary (basierend auf der Berufserfahrung):

Code
lm_fit <- lm_model |> fit(Salary ~ Years.Of.Experience, data = fd5_train)

Zusammenfassung des Ergebnis:

Code
summary <- lm_fit |> extract_fit_engine() |> summary()
summary

Call:
stats::lm(formula = Salary ~ Years.Of.Experience, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-149686  -22470   -6278   21338   94530 

Coefficients:
                    Estimate Std. Error t value Pr(>|t|)    
(Intercept)         116445.0      429.6  271.05   <2e-16 ***
Years.Of.Experience  42366.7      428.0   98.98   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 30730 on 5115 degrees of freedom
Multiple R-squared:  0.657, Adjusted R-squared:  0.6569 
F-statistic:  9797 on 1 and 5115 DF,  p-value: < 2.2e-16

Vorhersagen auf Trainings- und Testdatensatz:

Nun werden Vorhersagen für die Tranings-, sowie Testdaten erstellt. Anaschließend werden die tatsächlichen “Salary”-Werte mit den Vorhersagen kombiniert. Dies geschieht um zwei seperate Datenrahmen zu erstellen.

Code
pred_train <- predict(lm_fit, new_data = fd5_train) |> rename("pred_train" = ".pred")
pred_test <- predict(lm_fit, new_data = fd5_test) |>  rename("pred_test" = ".pred")

compare_train <- fd5_train |> 
  select(Salary) |> 
  bind_cols(pred_train)
head(compare_train)
# A tibble: 6 × 2
  Salary pred_train
   <dbl>      <dbl>
1  60000     66278.
2  90000     80406.
3  85000     80406.
4  55000     66278.
5  75000     73342.
6  60000     66278.
Code
compare_test <- fd5_test |> 
  select(Salary) |> 
  bind_cols(pred_test)
head(compare_test)
# A tibble: 6 × 2
  Salary pred_test
   <dbl>     <dbl>
1  90000    80406.
2  70000    73342.
3  60000    66278.
4 125000   101598.
5 130000   101598.
6  95000    87470.

7.1.4.: Grafische Darstellung

Im folgenden Codechunk, werden zwei Grafiken, zum Einen für die Testendaten und zum anderen für die Traiingsdaten erstellt.

Code
train_data <- cbind(fd5_train, pred_train)
test_data <- cbind(fd5_test, pred_test)

ggplot(train_data, aes(x = Years.Of.Experience, y = Salary)) +
  geom_point(color = viridis(0.50), alpha = 0.5) +
  geom_line(aes(y = pred_train), color = "deeppink3", size = 1) +
  labs(title = "Vorhersage auf Trainingsdaten",
       x = "Years of Experience",
       y = "Salary") +
  scale_color_identity() +
  scale_y_continuous(labels = scales::comma) +
  theme_minimal()
Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.

Code
ggplot(test_data, aes(x = Years.Of.Experience, y = Salary)) +
  geom_point(color = viridis(0.50), alpha = 0.5) +
  geom_line(aes(y = pred_test), color = "deeppink3", size = 1) +
  labs(title = "Vorhersage auf Testdaten",
       x = "Years of Experience",
       y = "Salary") +
  scale_color_identity() +
  scale_y_continuous(labels = scales::comma) +
  theme_minimal()

Anhand der zwei Grafiken ist zu erkennen, dass die unterschiedlichen Werte bei der Vorhersage der Trainingsdaten deutlich dichter zusammen liegen, als bei den Testdaten. Trotzdem sind die beiden Grafiken gleich was den Trend angeht. Dies ist Mithilfe der Regressionsgerade zu erkennen.

7.1.5.: Fehler

Mithilfe der “rmse”-Funktion, wird die Quadratwurzel aus dem Durchschnitt der quadrierten Differenzen zwischen den vorhergesagten und den tatsächlichen Werten.

Trainingsfehler:

Code
rmse(compare_train, Salary, pred_train)
# A tibble: 1 × 3
  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 rmse    standard      30725.

Die durchschnittliche Abweichung beträgt rund 31.000.

Testfehler:

Code
rmse(compare_test, Salary, pred_test)
# A tibble: 1 × 3
  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 rmse    standard      30764.

Auch hier beträgt die durchschnittliche Abweichung rund 31.000.

Zur Einordnung der Fehler wird die Verteilung von Gehalt angesehen:

Code
describe(filtered_data5, Salary)
variable = Salary
type     = double
na       = 0 of 6 398 (0%)
unique   = 432
min|max  = 550 | 250 000
q05|q95  = 35 000 | 195 000
q25|q75  = 70 000 | 160 000
median   = 120 000
mean     = 116 787.2

Verteilung von Arbeitserfahrung:

Code
describe(filtered_data5, Years.Of.Experience)
variable = Years.Of.Experience
type     = double
na       = 0 of 6 398 (0%)
unique   = 37
min|max  = 0 | 34
q05|q95  = 1 | 19
q25|q75  = 3 | 12
median   = 7
mean     = 8.101751

7.1.6.: Residuen

Residuen (auch Fehler oder Residuen genannt) sind die Unterschiede zwischen den beobachteten Werten und den vorhergesagten Werten in einem Regressionsmodell. Sie stellen die Abweichungen zwischen den tatsächlichen Daten und den durch das Modell vorhergesagten Werten dar. Idealerweise sollten die Residuen normalverteilt sein, um sicherzustellen, dass das Regressionsmodell angemessen ist.

Es ist üblich, die Residuen sowohl für Trainingsdaten als auch für Testdaten zu überprüfen, um die Leistung des Modells auf beiden Datensätzen zu evaluieren. Hier sind einige Gründe, warum es wichtig ist, die Residuen auf beiden Datensätzen zu betrachten:

  1. Trainingsdaten:

    • Die Residuen der Trainingsdaten geben Ihnen einen Einblick in die Leistung des Modells auf den Daten, auf denen es trainiert wurde. Wenn die Residuen auf den Trainingsdaten ungewöhnliche Muster aufweisen, kann dies auf Modellprobleme oder Overfitting hinweisen.
  2. Testdaten:

    • Die Residuen der Testdaten ermöglichen es Ihnen, die Generalisierungsfähigkeit des Modells auf neuen, nicht trainierten Daten zu überprüfen. Ein Modell kann auf den Trainingsdaten gut funktionieren, aber die Residuen auf den Testdaten können Ihnen sagen, wie gut es sich auf unbekannte Daten verallgemeinert.

Nun werden die Risiduen mit der “augment()”-Funktion auf die Trainings-, sowie Testdaten abgerufen. Anschließend werden Sie ausgegeben.

Code
residuals_train <- augment(lm_fit, new_data = fd5_train) %>% select(.resid)

residuals_test <- augment(lm_fit, new_data = fd5_test) %>% select(.resid)

print(residuals_train)
# A tibble: 5,117 × 1
    .resid
     <dbl>
 1  -6278.
 2   9594.
 3   4594.
 4 -11278.
 5   1658.
 6  -6278.
 7 -11278.
 8   9594.
 9  -3342.
10  -6278.
# ℹ 5,107 more rows
Code
print(residuals_test)
# A tibble: 1,281 × 1
   .resid
    <dbl>
 1  9594.
 2 -3342.
 3 -6278.
 4 23402.
 5 28402.
 6  7530.
 7 -3342.
 8 28402.
 9  9594.
10 -3342.
# ℹ 1,271 more rows

Anschließend werden nun die Risiduen in einem Histogramm ausgegeben, nachdem Sie z-skaliert wurden.

Histogramm der Risiduen der Trainingsdaten:

Code
residuals_train$standardized_resid <- scale(residuals_train$.resid)

ggplot(data = residuals_train, aes(x = standardized_resid)) +
  geom_histogram(binwidth = 0.5, fill = viridis(1), color = "black", alpha = 0.7) +
  labs(title = "Histogramm der standardisierten Residuen",
       x = "Standardisierte Residuen",
       y = "Häufigkeit") +
  scale_fill_viridis() +  
  theme_minimal()

Zu erkennen ist, dass die Werte zwischen 2 und -2 am häufigsten vertreten sind.

Histogramm der Risiduen der Testdaten:

Code
residuals_test$standardized_resid <- scale(residuals_test$.resid)

ggplot(data = residuals_test, aes(x = standardized_resid)) +
  geom_histogram(binwidth = 0.5, fill = viridis(1), color = "black", alpha = 0.7) +
  labs(title = "Histogramm der standardisierten Residuen",
       x = "Standardisierte Residuen",
       y = "Häufigkeit") +
  scale_fill_viridis() +
  theme_minimal()

Auch hier sind die Risiduen zwischen 2 und -2 am häufigsten.

Aus den beiden Histogrammen geht also hervor, dass die Abweichungen zwischen den vorhergesagten Werten und tatsächlichen Werten nicht wirklich groß sind.

7.1.7.: Q-Q-Plot

Das “Quantil-Quantil-Diagramm” überprüft Risiduen auf Ihre Normalverteilung. Hierbei werden die Quantile der standartisierten Risiduen gegen die QUantile der Normalverteilung gestellt. Im Normalfall sollten die Punkte entlang der Diagonale (x=y) streuen.

QQ-Plot für der Risiduen für die Trainingsdaten:

Code
ggplot(data = residuals_train, aes(sample = standardized_resid)) +
  stat_qq(distribution = qnorm, dparams = list(mean = 0, sd = 1), color = viridis(1)) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "black") +
  labs(title = "QQ-Plot der standardisierten Residuen",
       x = "Quantile der Normalverteilung",
       y = "Quantile der Residuen") +
  scale_color_viridis() + 
  theme_minimal()

QQ-Plot für der Risiduen für die Testdaten:

Code
residuals_test$standardized_resid <- scale(residuals_test$.resid)
ggplot(data = residuals_test, aes(sample = standardized_resid)) +
  stat_qq(distribution = qnorm, dparams = list(mean = 0, sd = 1), color = viridis(1)) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "black") +
  labs(title = "QQ-Plot der standardisierten Residuen",
       x = "Quantile der Normalverteilung",
       y = "Quantile der Residuen") +
  scale_color_viridis() + 
  theme_minimal()

Die beiden Q-Q-Plots bilden die “Ausreißer” vom Gehalt nach oben oder unten, entlang der 45-Grad-Linie ab, welche bereits im ersten Diagramm von 7.1 zu sehen sind. Es ist zu erkennen, dass die Risiduen nicht perfekt normalverteilt sind. Es besteht die Möglichkeit, dass esDatenpunkte gibt, welche die Risiduen beeinflussen. Aufgrund der explorativen Datenanalyse ist bereits bekannt, das Jobs mit hoher Berufserfahrung oft Führungsverantwortung beinhalten, welche nochmals zusätzlich monetär honoriert wird. Rechts oben im Graph ist eine flache Linie zu erkennen. Diese deutet auf einen Gehaltscap hin. Die “Ausreißer” am unteren Ende lassen sichh durch z.B Einstiegsjobs, sowie Niedriglohnjobs ohne Hochschulabschluss erläutern. Desweiteren ist noch anzumerken, dass Ausbildungsberufe nicht beachtet werden.

7.2.: Mehrfache Lineare Regression

In dem folgenden Absatz wird eine lineare mehrfache Regression durchgeführt.

7.2.1.: Vorbereitung

Zunächst muss eine gewisse Vorbereitung getroffen werden.

In diesem Fall wird einmal der Adjusted R-Squad-Wert berechnet. Dieser gibt an wie gut eine Variable, in diesem Fall “Years of Experience” die Variationen in der abhängigen Variable ” Salary” in Ihrem Modell erklärt. Dies geschieht unter der Berücksichtigung der Anzahl von unabhängigen Variablen.

Code
linear_model <- lm(Salary ~ Years.Of.Experience, data = filtered_data3)

adjusted_r_squared <- summary(linear_model)$adj.r.squared

cat("Adjusted R-squared:", adjusted_r_squared, "\n")
Adjusted R-squared: 0.5713572 

Der Adjusted R-squared-Wert liegt zwischen 0 und 1. In diesem Fall bedeutet 0.5713572, dass etwa 57,14% der Variationen in der abhängigen Variable “Salary” durch die unabhängige Variable “Years.Of.Experience” im Modell erklärt werden können. Ein höherer Wert wäre Wünschenswert.

Nun werden Streudiagramme mit einer glättenden Funktion erstellt. Hierbei werden 3 Diagramme erstellt, wobei mit unterschiedlichen Potenzen gerechnet wird.

Code
library(ggplot2)
ggplot(data = filtered_data, aes(x = Years.Of.Experience, y = Salary)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ poly(x, 2), se = FALSE)

Code
library(ggplot2)
ggplot(data = filtered_data, aes(x = Years.Of.Experience, y = Salary)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ poly(x, 3), se = FALSE)

Code
library(ggplot2)
ggplot(data = filtered_data, aes(x = Years.Of.Experience, y = Salary)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ poly(x, 4), se = FALSE)

Aufgrund der Kurve wurde sich entschieden eine weitere Variable, sowie die Potenzen 2, 3 und 4 von ” Years of Experience” hinzuzufügen und anschließend je 3 unterschiedliche Regressionen durchzuführen. Anschließend wird dann geschaut, wie akkurat sich das Modell auf die Testdaten mit der jeweiligen Potenz verhält.

Da Age zwar einen hohen Korrelationswert hat aber auch mit den Years.Of.Experience einhergeht nehmen wir diesen wert nicht sondern stattdessen das Education.Level. Dies wird in den nächsten Absätzen behandelt.

7.2.2.: Korrelationen

Um die Korrelation von dem “Education Level” zu berechnen müssen die Werte erst von kategorisch zu nummerisch transformiert werden.

Code
filtered_data$Education.Level <- as.numeric(as.character(filtered_data$Education.Level))

str(filtered_data$Education.Level)
 num [1:6398] 2 1 2 2 1 2 2 2 1 1 ...
Code
correlations <- cor(filtered_data[c("Salary", "Age", "Years.Of.Experience", "Education.Level")])

print(correlations)
                       Salary       Age Years.Of.Experience Education.Level
Salary              1.0000000 0.7291603           0.8103542       0.6374551
Age                 0.7291603 1.0000000           0.9363709       0.5965278
Years.Of.Experience 0.8103542 0.9363709           1.0000000       0.6105127
Education.Level     0.6374551 0.5965278           0.6105127       1.0000000

Nun ist zu erkennen, dass zwischen dem Education Level und Salary eine Korrelation von 0.63 vorliegt. Zwischen dem Alter und den Bildungsniveau liegt dann eine Korrelation von 0.59. und dem ” Years of Experience” eine Korrelation von 0.61.

Es ist also zu erkennen, dass Die Korrelationen zischen den bildungsniveau und den anderen stets relativ hoch ist.

7.2.3.: Datenaufbereitung

Für die Regressionen sind nur die “Salary, Years of Experience, Education Level” relevant, also werden nur sie in den nen Datensatz geschrieben:

Code
filtered_data6 <- filtered_data %>%
  select(Salary, Years.Of.Experience, Education.Level)

Anschließend werden die “Years of Experience” potenziert und ausgegeben:

Code
filtered_data6 <- filtered_data6 %>%
  mutate(Years.Of.Experience_Squared = Years.Of.Experience^2) %>%
  mutate(Years.Of.Experience_Cubed = Years.Of.Experience^3) %>%
  mutate(Years.Of.Experience_Quartic = Years.Of.Experience^4)
Code
head(filtered_data6)
# A tibble: 6 × 6
  Salary Years.Of.Experience Education.Level Years.Of.Experience_Squared
   <dbl>               <dbl>           <dbl>                       <dbl>
1 110000                   5               2                          25
2  95000                   4               1                          16
3  90000                   3               2                           9
4  70000                   2               2                           4
5  60000                   1               1                           1
6  90000                   3               2                           9
# ℹ 2 more variables: Years.Of.Experience_Cubed <dbl>,
#   Years.Of.Experience_Quartic <dbl>

Nun wird wieder eine Z-Skalierung von “filtered_data6” durchgeführt.

Hierzu wird zunächst eine Kopie des Datensatzes erstellt. Anschließend werden dann die “Years of Experience” und das “Education Level” z-skaliert.

Code
# Erstellen Sie eine Kopie von filtered_data6
filtered_data6_z <- filtered_data6

# Z-Skalierung für Years.Of.Experience und Education.Level in filtered_data6_z durchführen
filtered_data6_z <- filtered_data6_z %>%
  mutate(
    Years.Of.Experience = scale(Years.Of.Experience),
    Education.Level = scale(Education.Level)
  )

Ergebnis der Z-Skalierung:

Code
head(filtered_data6_z)
# A tibble: 6 × 6
  Salary Years.Of.Experience[,1] Education.Level[,1] Years.Of.Experience_Squared
   <dbl>                   <dbl>               <dbl>                       <dbl>
1 110000                  -0.517               0.411                          25
2  95000                  -0.684              -0.724                          16
3  90000                  -0.851               0.411                           9
4  70000                  -1.02                0.411                           4
5  60000                  -1.18               -0.724                           1
6  90000                  -0.851               0.411                           9
# ℹ 2 more variables: Years.Of.Experience_Cubed <dbl>,
#   Years.Of.Experience_Quartic <dbl>

Nun wird die Standardabweichung der Berufserfahrung überprüft.

Code
sd(filtered_data6_z$Years.Of.Experience)
[1] 1
Code
sd(filtered_data6_z$Education.Level)
[1] 1

Bei beiden liegt eine Abweichung von 1 vor.

Um eine lineare Regression durchzuführen wird der Datensatz filtered_data_z in trainings und Testdaten eingeteilt. Mithilfe der Funktion “set.seed(007)” initialisiert den Zufallsgenerator mit einer festen Zahl, um sicherzustellen, dass die Ergebnisse bei jedem Durchlauf reproduzierbar sind. “initial_split” teilt dann den Datensatz in Tranings- und Testdaten. Der Parameter strata = Years.Of.Experience sorgt dafür, dass die Daten nach dem Gehalts-Wert stratifiziert werden, um sicherzustellen, dass die Trainings- und Testdaten eine ähnliche Verteilung von Gehalts-Werten aufweisen. Da die Potenzen dieser Variable alle in der selben Reihe stehen muss hier nichts verändert werden. Die Funktion training() extrahiert die Trainingsdaten aus dem aufgeteilten Datensatz, während testing() die Testdaten extrahiert.

Code
set.seed(007)  
filtered_data6_z <- initial_split(filtered_data6_z, prop = 0.8, strata = Years.Of.Experience)  

fd6_train <- training(filtered_data6_z)
fd6_test <- testing(filtered_data6_z)

7.2.3.: Modell Initialisieren

Nun muss das Modell initialisert werden.

Code
lm_model2 <- linear_reg() |> set_engine("lm")

Lineare Regression mit 2er Potenz:

Code
lm_fit2 <- lm_model2 |> fit(Salary ~ Years.Of.Experience + Education.Level + Years.Of.Experience_Squared, data = fd6_train)

Lineare Regression mit 3er Potenz:

Code
lm_fit3 <- lm_model2 |> fit(Salary ~ Years.Of.Experience + Education.Level + Years.Of.Experience_Cubed, data = fd6_train)

Lineare Regression mit 3er Potenz:

Code
lm_fit4 <- lm_model2 |> fit(Salary ~ Years.Of.Experience + Education.Level + Years.Of.Experience_Quartic, data = fd6_train)

Zusammenfassung des Ergebnis (2er Potenz):

Code
summary <- lm_fit2 |> extract_fit_engine() |> summary()
summary

Call:
stats::lm(formula = Salary ~ Years.Of.Experience + Education.Level + 
    Years.Of.Experience_Squared, data = data)

Residuals:
   Min     1Q Median     3Q    Max 
-83843 -18771  -3740  10782  90478 

Coefficients:
                              Estimate Std. Error t value Pr(>|t|)    
(Intercept)                 143592.201    882.844  162.65   <2e-16 ***
Years.Of.Experience          73825.758   1234.509   59.80   <2e-16 ***
Education.Level               6527.658    493.036   13.24   <2e-16 ***
Years.Of.Experience_Squared   -266.380      7.883  -33.79   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 26430 on 5113 degrees of freedom
Multiple R-squared:  0.7464,    Adjusted R-squared:  0.7463 
F-statistic:  5017 on 3 and 5113 DF,  p-value: < 2.2e-16

Zusammenfassung des Ergebnis (3er Potenz):

Code
# Zusammenfassung der Regression
summary <- lm_fit3 |> extract_fit_engine() |> summary()
summary

Call:
stats::lm(formula = Salary ~ Years.Of.Experience + Education.Level + 
    Years.Of.Experience_Cubed, data = data)

Residuals:
   Min     1Q Median     3Q    Max 
-84267 -19790  -3860  11280  91008 

Coefficients:
                            Estimate Std. Error t value Pr(>|t|)    
(Intercept)                1.261e+05  4.865e+02  259.13   <2e-16 ***
Years.Of.Experience        5.507e+04  7.975e+02   69.05   <2e-16 ***
Education.Level            7.198e+03  4.977e+02   14.46   <2e-16 ***
Years.Of.Experience_Cubed -5.905e+00  1.911e-01  -30.90   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 26830 on 5113 degrees of freedom
Multiple R-squared:  0.7386,    Adjusted R-squared:  0.7385 
F-statistic:  4817 on 3 and 5113 DF,  p-value: < 2.2e-16

Zusammenfassung des Ergebnis (4er Potenz):

Code
summary <- lm_fit4 |> extract_fit_engine() |> summary()
summary

Call:
stats::lm(formula = Salary ~ Years.Of.Experience + Education.Level + 
    Years.Of.Experience_Quartic, data = data)

Residuals:
   Min     1Q Median     3Q    Max 
-82732 -19598  -3836  11803  90306 

Coefficients:
                              Estimate Std. Error t value Pr(>|t|)    
(Intercept)                  1.213e+05  4.176e+02  290.40   <2e-16 ***
Years.Of.Experience          4.801e+04  6.640e+02   72.31   <2e-16 ***
Education.Level              8.034e+03  5.007e+02   16.05   <2e-16 ***
Years.Of.Experience_Quartic -1.569e-01  5.637e-03  -27.83   <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 27240 on 5113 degrees of freedom
Multiple R-squared:  0.7306,    Adjusted R-squared:  0.7305 
F-statistic:  4623 on 3 and 5113 DF,  p-value: < 2.2e-16

Vorhersagen auf Trainings- und Testdatensatz (2er Potenz):

Code
pred_train2 <- predict(lm_fit2, new_data = fd6_train) |> rename("pred_train2" = ".pred")
pred_test2 <- predict(lm_fit2, new_data = fd6_test) |>  rename("pred_test2" = ".pred")

compare_train2 <- fd5_train |> 
  select(Salary) |> 
  bind_cols(pred_train2)
head(compare_train2)
# A tibble: 6 × 2
  Salary pred_train2
   <dbl>       <dbl>
1  60000      51180.
2  90000      81077.
3  85000      73668.
4  55000      51180.
5  75000      70099.
6  60000      51180.
Code
compare_test2 <- fd5_test |> 
  select(Salary) |> 
  bind_cols(pred_test2)
head(compare_test2)
# A tibble: 6 × 2
  Salary pred_test2
   <dbl>      <dbl>
1  90000     81077.
2  70000     70099.
3  60000     58589.
4 125000    110813.
5 130000    110813.
6  95000     84113.

Vorhersagen auf Trainings- und Testdatensatz (3er Potenz):

Code
pred_train3 <- predict(lm_fit3, new_data = fd6_train) |> rename("pred_train3" = ".pred")
pred_test3 <- predict(lm_fit3, new_data = fd6_test) |>  rename("pred_test3" = ".pred")

compare_train3 <- fd6_train |> 
  select(Salary) |> 
  bind_cols(pred_train3)
head(compare_train3)
# A tibble: 6 × 2
  Salary pred_train3
   <dbl>       <dbl>
1  60000      55650.
2  90000      82029.
3  85000      73860.
4  55000      55650.
5  75000      72960.
6  60000      55650.
Code
compare_test3 <- fd6_test |> 
  select(Salary) |> 
  bind_cols(pred_test3)
head(compare_test3)
# A tibble: 6 × 2
  Salary pred_test3
   <dbl>      <dbl>
1  90000     82029.
2  70000     72960.
3  60000     63819.
4 125000    108458.
5 130000    108458.
6  95000     82823.

Vorhersagen auf Trainings- und Testdatensatz (4er Potenz):

Code
pred_train4 <- predict(lm_fit4, new_data = fd6_train) |> rename("pred_train4" = ".pred")
pred_test4 <- predict(lm_fit4, new_data = fd6_test) |>  rename("pred_test4" = ".pred")

compare_train4 <- fd6_train |> 
  select(Salary) |> 
  bind_cols(pred_train4)
head(compare_train4)
# A tibble: 6 × 2
  Salary pred_train4
   <dbl>       <dbl>
1  60000      58600.
2  90000      83717.
3  85000      74598.
4  55000      58600.
5  75000      75721.
6  60000      58600.
Code
compare_test4 <- fd6_test |> 
  select(Salary) |> 
  bind_cols(pred_test4)
head(compare_test4)
# A tibble: 6 × 2
  Salary pred_test4
   <dbl>      <dbl>
1  90000     83717.
2  70000     75721.
3  60000     67719.
4 125000    107542.
5 130000    107542.
6  95000     82576.

7.2.4.: Grafische Darstellung

In dem folgenden Absatz werden die unterschiedlichen Potenzen mithilfe eines Vorhersage Plots grafiosch dargestellt.

Hierzu wurde eine zusätzliche Quelle verwendet: ( https://statologie.de/vorhergesagte-werte-plotten-r/)

Die folgenden Codechunks wird immer der gleiche Aufbau verwendet. Bloß stets mit den unterschiedlichen Potenzen. Zunächst wird der Graph für den Trainingdatensatz und anschließend für den Testdtaensatz erstellt.

2er Potenz:

Code
ggplot(compare_train2, aes(x = Salary, y = pred_train2)) +
  geom_point(color = viridis(0.50)) +
  geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
  geom_smooth(method = "lm", formula = y ~ poly(x, 3), se = FALSE) +
  labs(title = "Vorhersage-Plot für Trainingsdatensatz",
       x = "Echte Salary-Werte",
       y = "Vorhergesagte Salary-Werte") +
  theme_minimal()

Code
ggplot(compare_test2, aes(x = Salary, y = pred_test2)) +
  geom_point(color = viridis(0.50)) +
  geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
  geom_smooth(method = "lm", formula = y ~ poly(x, 2), se = FALSE) +
  labs(title = "Vorhersage-Plot für Testdatensatz",
       x = "Echte Salary-Werte",
       y = "Vorhergesagte Salary-Werte") +
  theme_minimal()

3er Potenz:

Code
ggplot(compare_train3, aes(x = Salary, y = pred_train3)) +
  geom_point(color = viridis(0.50)) +
  geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
  geom_smooth(method = "lm", formula = y ~ poly(x, 3), se = FALSE) +
  labs(title = "Vorhersage-Plot für Trainingsdatensatz",
       x = "Echte Salary-Werte",
       y = "Vorhergesagte Salary-Werte") +
  theme_minimal()

Code
ggplot(compare_test3, aes(x = Salary, y = pred_test3)) +
  geom_point(color = viridis(0.50)) +
  geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
  geom_smooth(method = "lm", formula = y ~ poly(x, 3), se = FALSE) +
  labs(title = "Vorhersage-Plot für Testdatensatz",
       x = "Echte Salary-Werte",
       y = "Vorhergesagte Salary-Werte") +
  theme_minimal()

4er Potenz:

Code
ggplot(compare_train4, aes(x = Salary, y = pred_train4)) +
  geom_point(color = viridis(0.50)) +
  geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
  geom_smooth(method = "lm", formula = y ~ poly(x, 3), se = FALSE) +
  labs(title = "Vorhersage-Plot für Trainingsdatensatz",
       x = "Echte Salary-Werte",
       y = "Vorhergesagte Salary-Werte") +
  theme_minimal()

Code
ggplot(compare_test4, aes(x = Salary, y = pred_test4)) +
  geom_point(color = viridis(0.50)) +
  geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
  geom_smooth(method = "lm", formula = y ~ poly(x, 4), se = FALSE) +
  labs(title = "Vorhersage-Plot für Testdatensatz",
       x = "Echte Salary-Werte",
       y = "Vorhergesagte Salary-Werte") +
  theme_minimal()

Es ist bereits eine Tendenz zu erkennen. Die 4er Potenz der Berufserfahrung auf einer minimal genaueren Prognose bei den Testdaten, im Vergleich zu der 2er und 3er Potenz, resultiert.

7.2.5.: Fehler

AUch hier werden die Potenzen einzeln und hintereinander mit dem “rmse” untersucht.

2er Potenz

Trainingsfehler:

Code
rmse(compare_train2, Salary, pred_train2)
# A tibble: 1 × 3
  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 rmse    standard      26417.

Testfehler:

Code
rmse(compare_test2, Salary, pred_test2)
# A tibble: 1 × 3
  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 rmse    standard      26629.

Es geht hervor, dass das Modell auf den den Trainingsdaten besser perfomt als auf den Testdaten

Diese Tatsache weißt auf Overfitting hin.

3er Potenz:

Trainingsfehler:

Code
rmse(compare_train3, Salary, pred_train3)
# A tibble: 1 × 3
  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 rmse    standard      26820.

Testfehler:

Code
rmse(compare_test3, Salary, pred_test3)
# A tibble: 1 × 3
  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 rmse    standard      27035.

Auch hier performt das Modell besser auf den Trainingsdaten. Dies weist ebenfalls auf Overfitting hin.

4er Potenz:

Trainingsfehler:

Code
rmse(compare_test4, Salary, pred_test4)
# A tibble: 1 × 3
  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 rmse    standard      27457.

Testfehler:

Code
rmse(compare_test4, Salary, pred_test4)
# A tibble: 1 × 3
  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 rmse    standard      27457.

Auch wenn alle Modelle nur geringe Unterschiede aufweisen, performt dieses auf den Trainingsdaten gleich wie auf den Testdaten. Demnach ist es das präziseste Modell und wird als einzigstes weiter verwendet und weiter verwendet.

Dies ließ sich bereits unter 7.2.1 Erkenne da das 3. polynom das Geom Smooth Grafisch die beste Linie abgebildet hat.

!Zur Einordnung der Fehler die Verteilung von Gehalt ansehen:

Verteilung von Gehalt:

Code
describe(filtered_data5, Salary)
variable = Salary
type     = double
na       = 0 of 6 398 (0%)
unique   = 432
min|max  = 550 | 250 000
q05|q95  = 35 000 | 195 000
q25|q75  = 70 000 | 160 000
median   = 120 000
mean     = 116 787.2

7.2.6.: Residuen

Der Aufbau, sowie die Definiton zu den Risiduen wurden bereits unter 7.1.6 aufgeführt.

Deswegen werden die Funtkionen ebenfalls nicht erneut erklärt.

Es wird sich jediglich nur um die Ausgabe gekümmert, und anschließend beschrieben.

Code
residuals_train2 <- augment(lm_fit4, new_data = fd6_train) %>% select(.resid)

residuals_test2 <- augment(lm_fit4, new_data = fd6_test) %>% select(.resid)

print(residuals_train2)
# A tibble: 5,117 × 1
   .resid
    <dbl>
 1  1400.
 2  6283.
 3 10402.
 4 -3600.
 5  -721.
 6  1400.
 7 -3600.
 8  6283.
 9 -5721.
10  1400.
# ℹ 5,107 more rows
Code
print(residuals_test2)
# A tibble: 1,281 × 1
   .resid
    <dbl>
 1  6283.
 2 -5721.
 3 -7719.
 4 17458.
 5 22458.
 6 12424.
 7 -5721.
 8 22458.
 9  6283.
10 -5721.
# ℹ 1,271 more rows

Histogramm der standardisierten Residuen der Trainingsdaten:

Code
residuals_train2$standardized_resid2 <- scale(residuals_train2$.resid)

ggplot(data = residuals_train2, aes(x = standardized_resid2)) +
  geom_histogram(binwidth = 0.5, fill = viridis(1), color = "black", alpha = 0.7) +
  labs(title = "Histogramm der standardisierten Residuen",
       x = "Standardisierte Residuen",
       y = "Häufigkeit") +
  scale_fill_viridis() +
  theme_minimal()

Zu erkennen ist, dass die Werte zwischen 2 und -2 am häufigsten vertreten sind.

Histogramm der standardisierten Residuen der Testdaten:

Code
# Standardisierung/Z-Skalierung der Residuen der Residuen
residuals_test2$standardized_resid2 <- scale(residuals_test2$.resid)

# Histogramm der standardisierten Residuen mit Viridis-Farbschema
ggplot(data = residuals_test2, aes(x = standardized_resid2)) +
  geom_histogram(binwidth = 0.5, fill = viridis(1), color = "black", alpha = 0.7) +
  labs(title = "Histogramm der standardisierten Residuen",
       x = "Standardisierte Residuen",
       y = "Häufigkeit") +
  scale_fill_viridis() +  # Fügt das Viridis-Farbschema hinzu
  theme_minimal()

Auch hier sind die Risiduen zwischen 2 und -2 am häufigsten.

Aus den beiden Histogrammen geht also hervor, dass die Abweichungen zwischen den vorhergesagten Werten und tatsächlichen Werten nicht wirklich groß sind.

7.2.7.: Q-Q-Plot

Wie auch bei den Risiduen bleibt hier der Aufbau gleich wie in 7.1.7.

Jediglich die Aussagen sind erneut anders.

Trainingsdaten:

Code
ggplot(data = residuals_train2, aes(sample = standardized_resid2)) +
  stat_qq(distribution = qnorm, dparams = list(mean = 0, sd = 1), color = viridis(1)) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "black") +
  labs(title = "QQ-Plot der standardisierten Residuen",
       x = "Quantile der Normalverteilung",
       y = "Quantile der Residuen") +
  scale_color_viridis() + 
  theme_minimal()

Testdaten

Code
ggplot(data = residuals_test2, aes(sample = standardized_resid2)) +
  stat_qq(distribution = qnorm, dparams = list(mean = 0, sd = 1), color = viridis(1)) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "black") +
  labs(title = "QQ-Plot der standardisierten Residuen",
       x = "Quantile der Normalverteilung",
       y = "Quantile der Residuen") +
  scale_color_viridis() + 
  theme_minimal()

Der Plot Bildet die Ausreißer vom Gehalt nach oben und unten ab welche wir im ersten Diagramm von 7.2.1 sehen, die Residuen sind nicht perfekt normalverteilt. Eventuell gibt es hier Datenpunkte welche die Residuen beeinflussen. Aufgrund der explorativen Datenanalyse wissen wir das Jobs mit hoher Arbeitserfahrung oft Führungsverantwortung beinhalten welche nochmal zusätzlich monetär honoriert wird. Die Flache Linie durch die Gerade oben durch deutet auf ein Gehaltscap hin. Die Ausreißer am unteren Ende lassen sich durch Einstiegsjobs so wie Niedriglohnjobs ohne Hochschulabchlüsse erklären. (Ausbildungsberufe werden hier nicht berücksichtigt).

Der Testfehler in der einfachen Linearen Regression betrug 30763 während der in der mehrfachen Linearen Regression mit der 4er Potenz von Arbeitserfahrung 27456 welches eine verbesserung der Vorhersagen von 10% gegenüber der einfach Linearen regression aus 7.1 ergibt. Des weiteren gibt es hier auch kein Overfitting des Modells mehr da die Test und Trainingsfehler exakt die selben sind (27456) .

7.3.: Entscheidungsbaum

Mithilfe dieses Entscheidungsproblems soll eine Vorhersage, des Erreichens einer Managementsposition anhand von Faktoren mit der größten Korrelation, getroffen werden.

Hierzu werden die Software Engineering Jobs und deren Führungsposition bertrachtet. Die Führungsposition heißt “Software Engineering Manager”.

7.3.1.: Vorbereitung

Zunächst wurden beide Jobs nach dem Kriterium einer Häufigkeitsverteilung von N>30 ausgewählt.

Die Gründe sind in 5.1 aufgezählt.

Hierzu wird zunächst einen Datenrahmen erstellt, der die Job-Titel und Ihre Häufigkeit enthält.

Anschließend wird dann ein Balkendiagramm erstellt.

Code
library(ggplot2)
library(viridis)

jobs_count <- filtered_data %>%
  filter(Job.Title %in% c("Software Engineer", "Software Engineer Manager", "Data Scientist", "Director of Data Science")) %>%
  group_by(Job.Title) %>%
  summarize(count = n())

ggplot(jobs_count, aes(x = Job.Title, y = count, fill = Job.Title)) +
  geom_bar(stat = "identity") +
  scale_fill_manual(values = c(viridis(2), viridis(2))) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Hier ist zu erkennen, dass es natürlich deutlich weniger Director und Manager gibt.

Nun wird noch einmal, das Durchschnittsgehalt der verschiedenen Jobs berechnet.

Code
filtered_data %>%
  filter(Job.Title %in% c("Software Engineer", "Software Engineer Manager", "Data Scientist", "Director of Data Science")) %>%
  group_by(Job.Title) %>%
  summarise(Avg_Salary = mean(Salary, na.rm = TRUE))
# A tibble: 4 × 2
  Job.Title                 Avg_Salary
  <chr>                          <dbl>
1 Data Scientist               164099.
2 Director of Data Science     204561.
3 Software Engineer            120541.
4 Software Engineer Manager    172502.

7.3.2.: Datenaufbereitung

Vorab ist es wichtig zu erwähnen, dass keine Z-Skalierung der Daten durchgeführt wird. Dies liegt daran, da sonst die Diagramme unübersichtlich werden.

Zunächst werden alle benötigten Jobtitel aus dem Datenrahmen rausgefiltert.

Code
filtered_data7 <- filtered_data %>%
  filter(Job.Title %in% c("Software Engineer", "Software Engineer Manager", "Data Scientist", "Director of Data Science"))

Asnchließend werden den Managern und Director der Wert 1 zugewiesen.

Code
filtered_data7 <- filtered_data7 %>%
  mutate(Manager = ifelse(Job.Title %in% c("Director of Data Science", "Software Engineer Manager"), 1, 0))

Aufteilung in Test- & Trainingsdaten:

Code
set.seed(007)  
filtered_data7 <- initial_split(filtered_data7, prop = 0.8, strata = Years.Of.Experience)  

fd7_train <- training(filtered_data7)
fd7_test <- testing(filtered_data7)

7.3.3.: Modell Initialisieren

Initialisierung:

Code
tree_mod <- decision_tree(mode = "regression")

Modell trainieren:

Code
tree_fit <- tree_mod %>% 
  fit(Manager ~ Age + Gender + Education.Level + Years.Of.Experience + Senior + Expat + Country, data = fd7_train)

7.3.4.: Grafische Darstellung

Vorab eine grafische Darstellung mit den absoluten Zahlen:

Code
tree_fit |> 
  extract_fit_engine() |> 
  rpart.plot(digits = 1)
Warning: Cannot retrieve the data used to build the model (so cannot determine roundint and is.binary for the variables).
To silence this warning:
    Call rpart.plot with roundint=FALSE,
    or rebuild the rpart model with model=TRUE.

Mit Beschriftungen (Als Klassifizierung umgesetzt/ In Klassen umgewandelt).

Nun wird das ganze als Klassifikation umgesetzt. Hierbei wird in Klassen umgewandelt.

Hierzu wird zunächst eine Kopie des Trainingsatzes erstellt. Anschließend wird die Konvertierung von “Education Level” und “Manager” umgekehrt. Folgend wird dann das Baumodell erstellt, gefittet und zum Schluss visualisiert.

Code
fd7_train2 <- fd7_train

fd7_train2$Education.Level <- factor(fd7_train2$Education.Level, levels = c(0, 1, 2, 3), labels = c("Highschool", "Bachelor", "Master", "Doctor"))

fd7_train2$Manager <- factor(fd7_train2$Manager, levels = c(0, 1), labels = c("Employee", "Manager"))

fd7_train2$Senior <- factor(fd7_train2$Senior, levels = c(0, 1), labels = c("Junior", "Senior"))

tree_mod2 <- decision_tree(mode = "classification")

tree_fit2 <- tree_mod2 %>% 
  fit(as.factor(Manager) ~ Age + Gender + Education.Level + Years.Of.Experience + Senior + Expat + Country, data = fd7_train2)

tree_fit |> 
  extract_fit_engine() |> 
  rpart.plot(digits = 1)
Warning: Cannot retrieve the data used to build the model (so cannot determine roundint and is.binary for the variables).
To silence this warning:
    Call rpart.plot with roundint=FALSE,
    or rebuild the rpart model with model=TRUE.

Nach Ansehen des Entscheidungsbaumes, scheint es als hätten “Expat”, sowie “Country” eine schwache Vorhersagekraft und Mangelnde Bedeutung auf den Wert Manager. Deswegen tauchen sie nicht im Entscheidungsbaum auf.

Es gibt durchaus die Möglichkeit einen Entscheidungsbaum-Algorithmus Zur Regression auf eine Variable anzuwenden, die nur die Werte 0 und 1 aufweist. Ist dies der Fall, würde der Baum versuchen eine Regression, auf Basis der gegebenen Eingabevariable ( Features ) durchzuführen. Dadurch würde die kontinuierliche numerische Variable vorherzusagen.

(!!! Umschreiben
Ja, Sie können durchaus einen Entscheidungsbaum-Algorithmus zur Regression auf eine Variable anwenden, die nur Werte von 0 und 1 aufweist. In diesem Fall würde der Baum versuchen, auf Basis der gegebenen Eingabevariablen (Features) eine Regression durchzuführen, um die kontinuierliche numerische Variable vorherzusagen. )

Es gibt jedoch einige wichtige Aspekte zu beachten:

  1. Ausgabe als Kategorie interpretieren: Wenn Ihre Zielvariable tatsächlich binär ist und Sie eine Klassifizierung (0 oder 1) vornehmen wollen, dann sollten Sie einen Klassifikationsalgorithmus verwenden, nicht eine Regressionsmethode. Ein Entscheidungsbaum für die Klassifikation würde besser geeignet sein, um Vorhersagen in Form von Kategorien (hier: 0 oder 1) zu treffen.

  2. Interpretation der Vorhersagen: Wenn Sie den Entscheidungsbaum für die Regression auf eine binäre Variable anwenden, werden die Vorhersagen des Modells als kontinuierliche Werte zwischen 0 und 1 liegen. Diese Vorhersagen können dann als Wahrscheinlichkeiten interpretiert werden, z.B. als die Wahrscheinlichkeit, dass eine bestimmte Beobachtung den Wert 1 annimmt. Um Klassen vorherzusagen, müssten Sie normalerweise einen Schwellenwert festlegen (zum Beispiel 0,5), um diese Wahrscheinlichkeiten in Klassen umzuwandeln.

Vorhersage auf Test- und Trainingsdaten:

Code
head(fd7_train)
# A tibble: 6 × 16
  Job.Title    job_count   Age Gender Education.Level Years.Of.Experience Salary
  <chr>            <int> <dbl> <chr>            <dbl>               <dbl>  <dbl>
1 Data Scient…       515    29 Male                 2                 3    75000
2 Data Scient…       515    26 Female               2                 1.5  45000
3 Data Scient…       515    30 Male                 3                 5   180000
4 Data Scient…       515    30 Female               3                 5   180000
5 Data Scient…       515    27 Male                 3                 2   115000
6 Data Scient…       515    30 Female               3                 5   180000
# ℹ 9 more variables: Country <chr>, Race <chr>, Senior <dbl>, SalaryKat <fct>,
#   ID <int>, job_type <dbl>, Expat <dbl>, BIP_Per_Person <dbl>, Manager <dbl>
Code
pred_train7 <- predict(tree_fit, new_data = fd7_train) |> rename("pred_train" = ".pred")
pred_test7 <- predict(tree_fit, new_data = fd7_test) |>  rename("pred_test" = ".pred")

compare_train7 <- fd7_train |> 
  select(Manager) |> 
  bind_cols(pred_train7)
head(compare_train7)
# A tibble: 6 × 2
  Manager pred_train
    <dbl>      <dbl>
1       0     0.0110
2       0     0.0110
3       0     0.0110
4       0     0.0110
5       0     0.0110
6       0     0.0110
Code
compare_test7 <- fd7_test |> 
  select(Manager) |> 
  bind_cols(pred_test7)
head(compare_test7)
# A tibble: 6 × 2
  Manager pred_test
    <dbl>     <dbl>
1       0    0     
2       0    0.0110
3       0    0.0110
4       0    0.0110
5       0    0.0110
6       0    0.0110

7.3.5.: Fehler

Trainings- und Testfehler:

Code
library(yardstick)

rmse_train <- compare_train7 %>%
  mutate(Manager = as.numeric(Manager)) %>% 
  yardstick::rmse(truth = Manager, estimate = pred_train)

rmse_test <- compare_test7 %>%
  mutate(Manager = as.numeric(Manager)) %>% 
  yardstick::rmse(truth = Manager, estimate = pred_test)

print(rmse_train)
# A tibble: 1 × 3
  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 rmse    standard       0.179
Code
print(rmse_test)
# A tibble: 1 × 3
  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 rmse    standard       0.198

Der Trainingsfehler ist geringer als der Testfehler. Dies weist darauf hin, dass das Modell leicht overfittet ist.

7.3.6.: Residuen

!! Umschreiben

Obwohl das abhängige Merkmal (‘Manager’) binär ist, kann die Anpassung eines Entscheidungsbaummodells (wie in Ihrem Fall) immer noch zur Vorhersage von Wahrscheinlichkeiten verwendet werden. Das Modell wird Wahrscheinlichkeiten für das Eintreten oder Nicht-Eintreten des Ereignisses (hier: Manager oder nicht Manager) vorhersagen.

Die Residuen in einem solchen Fall geben die Abweichung zwischen den tatsächlichen beobachteten Werten (0 und 1 in Ihrem Fall) und den vorhergesagten Wahrscheinlichkeiten wieder. Sie ermöglichen eine Überprüfung, wie gut das Modell die Beobachtungen anpasst. Obwohl sie nicht direkt die Vorhersage von 0 oder 1 zeigen, reflektieren sie immer noch, wie gut das Modell die Wahrscheinlichkeiten, dass ein bestimmtes Ereignis eintritt oder nicht, schätzt.

Code
residuals_train7 <- augment(tree_fit, new_data = fd7_train) %>% select(.resid)

residuals_test7 <- augment(tree_fit, new_data = fd7_test) %>% select(.resid)

print(residuals_train7)
# A tibble: 1,404 × 1
    .resid
     <dbl>
 1 -0.0110
 2 -0.0110
 3 -0.0110
 4 -0.0110
 5 -0.0110
 6 -0.0110
 7 -0.0110
 8 -0.0110
 9 -0.0110
10 -0.0110
# ℹ 1,394 more rows
Code
print(residuals_test7)
# A tibble: 353 × 1
    .resid
     <dbl>
 1  0     
 2 -0.0110
 3 -0.0110
 4 -0.0110
 5 -0.0110
 6 -0.0110
 7 -0.0110
 8 -0.0110
 9 -0.0110
10 -0.0110
# ℹ 343 more rows
Code
residuals_train7$standardized_resid7 <- scale(residuals_train7$.resid)

ggplot(data = residuals_train7, aes(x = standardized_resid7)) +
  geom_histogram(binwidth = 0.5, fill = viridis(1), color = "black", alpha = 0.7) +
  labs(title = "Histogramm der standardisierten Residuen",
       x = "Standardisierte Residuen",
       y = "Häufigkeit") +
  scale_fill_viridis() +
  theme_minimal()

Code
residuals_test7$standardized_resid7 <- scale(residuals_test7$.resid)

ggplot(data = residuals_test7, aes(x = standardized_resid7)) +
  geom_histogram(binwidth = 0.5, fill = viridis(1), color = "black", alpha = 0.7) +
  labs(title = "Histogramm der standardisierten Residuen",
       x = "Standardisierte Residuen",
       y = "Häufigkeit") +
  scale_fill_viridis() +
  theme_minimal()

7.3.7.: Q-Q-Plot / Accuracy test

Für ein Modell, das binäre Vorhersagen trifft (wie in diesem Fall mit einem Baummodell, das eine binäre Zielvariable vorhersagt), könnte ein QQ-Plot in Bezug auf die Residuen weniger sinnvoll sein. Der QQ-Plot wird üblicherweise verwendet, um die Normalität der Residuen in einem Modell zu überprüfen. Da bei binären Vorhersagen die Residuen nicht unbedingt einer Normalverteilung folgen müssen, kann ein QQ-Plot möglicherweise weniger aufschlussreich sein.

Insbesondere bei Klassifikationsmodellen, die binäre Kategorien vorhersagen, sind die Residuen möglicherweise nicht so interpretierbar wie bei Modellen mit kontinuierlichen Variablen.

Die Residuen bei binären Modellen können diskrete Werte oder eine Art von Klassifizierungsfehler (beispielsweise für binäre Klassifikationsmodelle) widerspiegeln. Ein QQ-Plot ist normalerweise dann sinnvoll, wenn die Residuen einer Normalverteilung folgen sollten, was jedoch bei binären Vorhersagen nicht zwangsläufig der Fall ist.

In solchen Fällen ist es oft wichtiger, andere Metriken wie Genauigkeit, Precision, Recall, ROC-Kurven oder AUC zu verwenden, um die Leistung des Modells zu bewerten und zu verstehen, wie gut es die binären Vorhersagen macht.

Siehe folgende links:

24 Evaluation Metrics for Binary Classification (And When to Use Them) (neptune.ai)

https://topepo.github.io/caret/measuring-performance.html

Nun werden zunächst die Faktoren kovertiert und levels gesetzt. Anschließend wird die Accuracy für die Tranings-, sowie für die Testdaten berechnet.

Code
library(caret)
Warning: Paket 'caret' wurde unter R Version 4.3.2 erstellt
Lade nötiges Paket: lattice
Warning: Paket 'lattice' wurde unter R Version 4.3.2 erstellt

Attache Paket: 'caret'
Die folgenden Objekte sind maskiert von 'package:yardstick':

    precision, recall, sensitivity, specificity
Das folgende Objekt ist maskiert 'package:purrr':

    lift
Code
compare_train7$Manager <- factor(compare_train7$Manager)
compare_train7$pred_train <- factor(compare_train7$pred_train, levels = levels(compare_train7$Manager))

compare_test7$Manager <- factor(compare_test7$Manager)
compare_test7$pred_test <- factor(compare_test7$pred_test, levels = levels(compare_test7$Manager))

accuracy_train <- confusionMatrix(compare_train7$Manager, compare_train7$pred_train)
print(accuracy_train)
Confusion Matrix and Statistics

          Reference
Prediction   0   1
         0 199   0
         1   0 174
                                     
               Accuracy : 1          
                 95% CI : (0.9902, 1)
    No Information Rate : 0.5335     
    P-Value [Acc > NIR] : < 2.2e-16  
                                     
                  Kappa : 1          
                                     
 Mcnemar's Test P-Value : NA         
                                     
            Sensitivity : 1.0000     
            Specificity : 1.0000     
         Pos Pred Value : 1.0000     
         Neg Pred Value : 1.0000     
             Prevalence : 0.5335     
         Detection Rate : 0.5335     
   Detection Prevalence : 0.5335     
      Balanced Accuracy : 1.0000     
                                     
       'Positive' Class : 0          
                                     
Code
compare_test7$pred_test <- factor(compare_test7$pred_test, levels = levels(compare_train7$Manager)) 

accuracy_test <- confusionMatrix(compare_test7$Manager, compare_test7$pred_test)
print(accuracy_test)
Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 60  0
         1  0 40
                                     
               Accuracy : 1          
                 95% CI : (0.9638, 1)
    No Information Rate : 0.6        
    P-Value [Acc > NIR] : < 2.2e-16  
                                     
                  Kappa : 1          
                                     
 Mcnemar's Test P-Value : NA         
                                     
            Sensitivity : 1.0        
            Specificity : 1.0        
         Pos Pred Value : 1.0        
         Neg Pred Value : 1.0        
             Prevalence : 0.6        
         Detection Rate : 0.6        
   Detection Prevalence : 0.6        
      Balanced Accuracy : 1.0        
                                     
       'Positive' Class : 0          
                                     
Code
# library(caret)
# compare_train7$pred_train <- factor(compare_train7$pred_train, levels = levels(compare_train7$Manager))
# 
# accuracy_train <- confusionMatrix(compare_train7$Manager, compare_train7$pred_train)
# print(accuracy_train)
# 
# compare_test7$pred_test <- factor(compare_test7$pred_test, levels = levels(compare_test7$Manager))
# 
# accuracy_test <- confusionMatrix(compare_test7$Manager, compare_test7$pred_test)
# print(accuracy_test)

Zusatz: Zuvor wurde der obrige Codechunk verwendet. Zum 7.12.2023 hat dieser Problemlos funktioniert. Zum 11.12.2023 hat dieser trotz identischen Codes (Gesamte Datei unverändert laut Github) nicht mehr funktioniert. Evtl. wurde die Library Caret in seiner Funktion geupdated (Und vorher eine veraltete Version genutzt) (Quelle 1). Es musste zusätzlich der Factor des “wahren” Werts von Manager auf sich selbst angepasst werden. Also von Char zu Faktor. Wobei ein Faktor hier den Zustand Manager abbildet mit dem Level = 1 = Manager (Quelle 2).

Quelle 1: https://stackoverflow.com/questions/51548908/error-data-and-reference-should-be-factors-with-the-same-levels

Quelle 2: https://bjoernwalther.com/variablen-in-r-als-faktor-definieren/

Die Confusion Matrix und die Statistiken werden verwendet, um die Leistung eines Klassifikationsmodells zu bewerten. In diesem Fall handelt es sich um eine binäre Klassifikation mit den Klassen 0 und 1.

Für die Confusion Matrix:

Trainingsdaten:

  • Es gibt insgesamt 373 Beobachtungen in den Trainingsdaten.

  • Von diesen wurden 199 korrekt als Klasse 0 und 174 korrekt als Klasse 1 vorhergesagt.

  • Es gab keine falsch vorhergesagten Werte für Klasse 0 oder Klasse 1.

  • Die Genauigkeit (Accuracy) beträgt 100%, was bedeutet, dass alle Vorhersagen korrekt waren.

  • Sensitivität, Spezifität, Positiver und Negativer Vorhersagewert sind alle 1, was bedeutet, dass alle Metriken perfekt sind.

Testdaten:

  • Es gibt insgesamt 100 Beobachtungen in den Testdaten.

  • Von diesen wurden 60 korrekt als Klasse 0 und 40 korrekt als Klasse 1 vorhergesagt.

  • Es gab keine falsch vorhergesagten Werte für Klasse 0 oder Klasse 1.

  • Auch hier beträgt die Genauigkeit 100%, was bedeutet, dass alle Vorhersagen korrekt waren.

  • Sensitivität, Spezifität, Positiver und Negativer Vorhersagewert sind alle 1, was auf perfekte Metriken hinweist.

In beiden Trainings- und Testdaten zeigt das Modell eine perfekte Vorhersagegenauigkeit und erzielt in allen Metriken (Sensitivität, Spezifität, etc.) die bestmöglichen Werte. Dies könnte darauf hindeuten, dass das Modell möglicherweise überangepasst (overfitted) ist, da es sowohl auf den Trainings- als auch auf den Testdaten perfekt funktioniert. Es ist wichtig, das Modell auf Daten zu bewerten, die es bisher nicht gesehen hat, um sicherzustellen, dass es generalisiert und nicht überangepasst ist.

8. Abschluss

8.1.: Kritik

Hätte man alle Betrachtungen under der gleichstellung von Years of Experience und Education level betrachten sollen bei länder und geschlechter vergleichen? Oder generell bei allen daten? Dies in die Datenaufbereitung mit aufnehemen? Dies bedarf genaueren untersuchungen

Hätte man alle nicht numerischen Werte numerisch transformieren können um andere Korrelationen und damit andere Regressionen herauszufinden?

Gibt es in China nur berichte von Westlichen Firmen die auch dort hohe Gehälter Zahlen (Niedriger BIP pro Person)

Hätte man den Entscheidungsbaum als reine klassifikation angehen sollen?

Hätte man sich in der gesamten analyse nur auf einige wenige jobs beschränken sollen um genauere ergebnisse mit weniger außreißern zu erzielen?

gibt es weitere methoden um die zuverlässigkeit des entscheidungsbaumes zu prüfen? wenn ja hätte man alle anwenden sollen um mehrere Faktoren zu beurteilen

Mit mehr Zeit hätten wir gerne die Data Frames übersichtlicher und einheitlicher transformiert. So haben wir ca 10 verschiedene dataframes mit teilweise ünübersichtlicher bennennung was nicht nur die durchlaufzeit erhöht sondern auch manchmal zu Problemen beim coden geführt hat.